home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / fpl-v115.lha / FPL / src / numexpr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-07  |  88.6 KB  |  2,739 lines
  1. /******************************************************************************
  2.  *                        FREXX PROGRAMMING LANGUAGE                          *
  3.  ******************************************************************************
  4.  
  5.  numexpr.c
  6.  
  7.  Supports *FULL* C language expression operator priority and much more...!
  8.  
  9.  *****************************************************************************/
  10.  
  11. /************************************************************************
  12.  *                                                                      *
  13.  * fpl.library - A shared library interpreting script langauge.         *
  14.  * Copyright (C) 1992-1994 FrexxWare                                    *
  15.  * Author: Daniel Stenberg                                              *
  16.  *                                                                      *
  17.  * This program is free software; you may redistribute for non          *
  18.  * commercial purposes only. Commercial programs must have a written    *
  19.  * permission from the author to use FPL. FPL is *NOT* public domain!   *
  20.  * Any provided source code is only for reference and for assurance     *
  21.  * that users should be able to compile FPL on any operating system     *
  22.  * he/she wants to use it in!                                           *
  23.  *                                                                      *
  24.  * You may not change, resource, patch files or in any way reverse      *
  25.  * engineer anything in the FPL package.                                *
  26.  *                                                                      *
  27.  * This program is distributed in the hope that it will be useful,      *
  28.  * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
  29.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 *
  30.  *                                                                      *
  31.  * Daniel Stenberg                                                      *
  32.  * Ankdammsgatan 36, 4tr                                                *
  33.  * S-171 43 Solna                                                       *
  34.  * Sweden                                                               *
  35.  *                                                                      *
  36.  * FidoNet 2:201/328    email:dast@sth.frontec.se                       *
  37.  *                                                                      *
  38.  ************************************************************************/
  39.  
  40. #ifdef AMIGA
  41. #include <exec/types.h>
  42. #include <proto/exec.h>
  43. #elif defined(UNIX)
  44. #include <sys/types.h>
  45. #endif
  46.  
  47. #include "script.h"
  48. #include <stdio.h>
  49. #include <stddef.h>
  50. #include <limits.h>
  51.  
  52. static ReturnCode AddUnary(struct Data *, struct Expr *, Operator);
  53. static ReturnCode Calc(struct Data *, struct Expr *, struct Expr *);
  54. static void INLINE HandleString(struct Data *, struct Expr *);
  55. static ReturnCode INLINE GetArrayInfo(struct Data *, long *, long *, long, char *);
  56. static ReturnCode INLINE Convert(struct Expr *, struct Data *);
  57. static void Clean(struct Data *, struct Expr *);
  58. static ReturnCode INLINE CallFunction(struct Data *, struct fplArgument *,
  59.                                       struct Identifier *);
  60. static ReturnCode INLINE PrototypeInside(struct Data *,
  61.                      struct Expr *val,
  62.                      long,
  63.                      struct Identifier *);
  64. static ReturnCode INLINE inside(struct Data *, struct fplArgument *,
  65.                                 struct Identifier *);
  66. #ifdef STRING_STACK
  67. static ReturnCode INLINE StringToStack(struct Data *,
  68.                                        struct fplStr **);
  69. static ReturnCode INLINE StringFromStack(struct Data *,
  70.                                          struct fplStr **);
  71. #endif
  72.  
  73. /***********************************************************************
  74.  *
  75.  * int Expression(struct Expr *, struct Data *, char, struct Local *)
  76.  *
  77.  * Returns a nonzero value if any error occured.
  78.  * The result of the Expression is returned in the Expr structure which you
  79.  * give the pointer to in the first argument.
  80.  *
  81.  *****************/
  82.  
  83. ReturnCode REGARGS
  84. Expression(struct Expr *val, /* return value struct pointer */
  85.            struct Data *scr, /* everything */
  86.            long control,    /* ESPECIALLLY DEFINED */
  87.            struct Identifier *ident) /* pointer to the pointer holding
  88.                                         the local variable names linked
  89.                                         list */
  90. {
  91.   struct Expr *expr, *basexpr;
  92.   ReturnCode ret;
  93.   struct Identifier *pident; /* general purpose struct identifier pointer */
  94.   struct Unary *un; /* general purpose struct Unary pointers */
  95.   long *dims=NULL; /* dimension pointer for variable arrays! */
  96.   long pos;       /* general purpose integer */
  97.   char *text;     /* general purpose char pointer */
  98.   char hit;
  99.   char *array;
  100.   long num;
  101.   long *nump;     /* for general purpose long pointers */
  102.   struct fplMsg *msg;
  103.   struct fplStr *string;
  104. #if defined(AMIGA) && defined(SHARED)
  105.   if(ret=CheckStack(scr, scr->stack_limit, scr->stack_margin)) {
  106.     if(ret==1)
  107.       return(FPLERR_OUT_OF_MEMORY);
  108.     else
  109.       return(FPLERR_OUT_OF_STACK);
  110.   }
  111. #endif
  112.  
  113.   GETMEM(expr, sizeof(struct Expr));
  114.   memset(expr, 0, sizeof(struct Expr));
  115.   basexpr=expr;
  116.  
  117.   while (1) {
  118.     if(ret=Eat(scr)) {       /* getaway blanks and comments */
  119.       if(control&CON_END && ret==FPLERR_UNEXPECTED_END) {
  120.         /* If there can be an unexpected ending, break out of the loop
  121.            with a nice return code! */
  122.         break;
  123.       }
  124.     } else if(expr->flags&FPL_STRING && !(control&CON_GROUNDLVL))
  125.       /* get outta string calcs if not on ground level! */
  126.       break;
  127.  
  128.     if(!(expr->flags&FPL_OPERAND)) {  /* operand coming up */
  129.  
  130.       if(control&CON_IDENT ||
  131.          isident(*scr->text)) {
  132.         /*
  133.          * It's a valid identifier character.
  134.          */
  135.         char *point;
  136.         num=0; /* Dimension counter when taking care of array variables */
  137.  
  138.  
  139.         if(control&CON_IDENT) {
  140.           if(!ident)
  141.             ret=FPLERR_IDENTIFIER_NOT_FOUND;
  142.           control&=~CON_IDENT; /* switch off that bit to get away from any
  143.                                   trouble such as double using this! */
  144.         } else {
  145.           CALL(Getword(scr));
  146.           ret=GetIdentifier(scr, scr->buf, &ident);
  147.         }
  148.  
  149.         point=scr->text;
  150.         Eat(scr); /* getaway blanks */
  151.  
  152.         /*
  153.          * `ret' can only be FPL_OK or FPLERR_IDENTIFIER_NOT_FOUND at this
  154.          * position.
  155.          */
  156.  
  157.         if(control&CON_DECLARE && *scr->text==CHAR_OPEN_PAREN) {
  158.       CALL(PrototypeInside(scr, val, control, ident));
  159.       expr->flags|=FPL_OPERAND|FPL_ACTION;
  160.  
  161.         } else if(control&CON_DECLARE ||
  162.                   (ident && ident->flags&FPL_VARIABLE)) {
  163.           /* The ident check above really must be there, otherwise we might
  164.              read it when it is a NULL pointer" */
  165.  
  166.           /* it's a variable */
  167.           pident=ident;
  168.           if(ret &&                     /* we didn't find it... */
  169.              !(control&CON_DECLARE))    /* and we're not declaring! */
  170.             /*
  171.              * We didn't find the requested identifier and we're *NOT*
  172.              * declaring. This means error!
  173.              */
  174.             return(ret);
  175.           else if(!ret) {
  176.         if(ident->flags&FPL_REFERENCE)
  177.           return FPLERR_ILLEGAL_VARIABLE; /* this is a reference _only_! */
  178.  
  179.             /* The symbol was found */
  180.         if(control&CON_LEVELOK) /* level _is_ OK! */
  181.           ;
  182.             else if(control&CON_DECLARE &&
  183.            (ident->level>=scr->varlevel || scr->varlevel==1)) {
  184.               /*
  185.                * If the name already declared in this (or higher) level
  186.                * and declaration is wanted.
  187.                */
  188.               if((ident->flags&FPL_STATIC_VARIABLE &&
  189.                   control&CON_DECLSTATIC &&
  190.                   ident->level==scr->varlevel) ||
  191.                  /*
  192.                   * If this is a `static' variable and the variable already
  193.                   * exists on this very level in this very function as static,
  194.                   * then skip this. It's perfectly OK to jump to the ending
  195.                   * semicolon since this has been parsed before!
  196.                   */
  197.  
  198.                  (ident->flags&FPL_EXPORT_SYMBOL && control&CON_DECLEXP)) {
  199.  
  200.                 /*
  201.                  * If this is an `export' symbol and it already exists as an
  202.                  * `export' symbol! Then just ignore this!
  203.                  */
  204.  
  205.                 /*
  206.                  * The current implementation unfortunately uses the statement
  207.                  * below to pass this declaration. That means comma-
  208.                  * separated exported symbols will be passed if only the first
  209.                  * is alredy declared... This will although work in all those
  210.                  * cases it is the SAME code that is executed twice!
  211.                  */
  212.  
  213.  
  214.                 if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
  215.                   return FPLERR_MISSING_SEMICOLON;
  216.                 scr->text--; /* get back on the semicolon! */
  217.                 break;
  218.               } else {
  219.                 CALL(Warn(scr, FPLERR_IDENTIFIER_USED));
  220.                 /* run it over! */
  221.                 DelIdentifier(scr, ident->name, NULL);
  222.               }
  223.             } else if(!(control&CON_DECLARE) &&
  224.                       (ident->level && /* not global */
  225.                        ident->level<(scr->varlevel-scr->level)))
  226.               /*
  227.                * From the wrong program level and we're not declaring.
  228.                */
  229.               return(FPLERR_IDENTIFIER_NOT_FOUND);
  230.             else if(ident->flags&FPL_STATIC_VARIABLE &&
  231.                     ((ident->func && (ident->func==scr->func)) ||
  232.                      ident->level>scr->varlevel)
  233.                     )
  234.               /*
  235.                * A static variable declared either in the wrong function or
  236.                * in a higher level!
  237.                */
  238.               return(FPLERR_IDENTIFIER_NOT_FOUND);
  239.           }
  240.  
  241.           text = NULL; /* no name information yet! */
  242.  
  243.       control &= ~CON_LEVELOK; /* forget about the level OK stuff!! */
  244.  
  245.           if(*scr->text==CHAR_OPEN_BRACKET) {
  246.             /*
  247.              * It's an array. Get the result of the expression within the
  248.              * square brackets.
  249.              */
  250.  
  251.             if(!dims) {
  252.               GETMEM(dims, MAX_DIMS*sizeof(long));
  253.             }
  254.             if(!(control&CON_DECLARE) && pident->data.variable.size)
  255.               num=pident->data.variable.num;
  256.             if(control&CON_DECLARE || num) {
  257.               /*
  258.                * Get the name now, cause the GetArrayInfo() call may
  259.                * destroy the 'scr->buf' buffer!
  260.                */
  261.               STRDUP(text, scr->buf);
  262.  
  263.               GETMEM(nump, sizeof(long));
  264.               *nump = num;
  265.               CALL(GetArrayInfo(scr, dims, nump, control, text));
  266.               num = *nump;
  267.               FREE(nump);
  268.               if(!(control&CON_DECLARE)) {
  269.                 /*
  270.                  * Free the name now, cause we don't declare anything
  271.                  * and this isn't needed any more!
  272.                  */
  273.                 FREE(text);
  274.                 text = NULL;
  275.               }
  276.               if(!(control&CON_DECLARE)) {
  277.                 if(num > pident->data.variable.num) {
  278.                   /*
  279.                    * If not declaring and overfilled quota: fail!
  280.                    *
  281.                    *
  282.                    * Copy the variable name to the buffer to make the
  283.                    * error message look good!
  284.                    */
  285.                   strcpy(scr->buf, pident->name);
  286.                   return FPLERR_ILLEGAL_ARRAY;
  287.                   
  288.                 } else {
  289.                   for(pos=0; pos<num; pos++)
  290.                     if(pident->data.variable.dims[pos]<=dims[pos]) {
  291.                       /*
  292.                        * Copy the variable name to the buffer to make the
  293.                        * error message look good!
  294.                        */
  295.                       strcpy(scr->buf, pident->name);
  296.                       return FPLERR_ILLEGAL_ARRAY;
  297.                     }
  298.                 }
  299.               }
  300.               point=scr->text; /* move point to current location  */
  301.               Eat(scr); /* pass all traling whitespaces */
  302.             }
  303.           }
  304.           if(control&CON_DECLARE) {
  305.             expr->flags|=FPL_ACTION;
  306.             GETMEM(pident, sizeof(struct Identifier));
  307.  
  308.             pident->level=
  309.               (control&(CON_DECLEXP|CON_DECLGLOB))?0:scr->varlevel;
  310.             pident->flags=
  311.               (control&CON_DECLINT?FPL_INT_VARIABLE:FPL_STRING_VARIABLE)|
  312.                 (control&CON_DECLEXP?FPL_EXPORT_SYMBOL:0)|
  313.                   (control&CON_DECLGLOB?FPL_GLOBAL_SYMBOL:
  314.                     (control&CON_DECLSTATIC?FPL_STATIC_VARIABLE:0))|
  315.                     (control&CON_DECL8?FPL_CHAR_VARIABLE:
  316.                      (control&CON_DECL16?FPL_SHORT_VARIABLE:0))|
  317.                        (control&CON_DECLCONST?FPL_READONLY:0);
  318.  
  319.             pident->file=scr->prog->name; /* file */
  320.  
  321.             pident->func=scr->func; /* declared in this function */
  322.  
  323.             /* Get variable name */
  324.             if(text)
  325.               /*
  326.                * The name has already been allocated above!
  327.                */
  328.               pident->name = text;
  329.             else {
  330.               /*
  331.                * Get the name!
  332.                */
  333.               STRDUP(pident->name, scr->buf); /* no real strdup */
  334.             }
  335.             if(num) {
  336.               /*
  337.                * Array variable declaration! It is a bit different from
  338.                * common variable declaration so I decided to put the code
  339.                * for it right here:
  340.                */
  341.               long size=dims[0]; /* array size */
  342.  
  343.               for(pos=1; pos<num; pos++)
  344.                 size*=dims[pos];
  345.  
  346.               /* Now `size' is the total number of members in the array we're
  347.                  about to declare */
  348.  
  349.               /* Get memory for the dimension array */
  350.               GETMEM(pident->data.variable.dims, num * sizeof(long));
  351.  
  352.               /* Copy the dim info to the newly allocated area */
  353.               memcpy((void *)pident->data.variable.dims, dims, num*sizeof(long));
  354.  
  355.               /* Get memory for the array  */
  356.               GETMEM(pident->data.variable.var.val32, size * sizeof(long));
  357.  
  358.               /* Set all string lengths to NULL and integers to zero: */
  359.               memset(pident->data.variable.var.val32, 0, size * sizeof(void *));
  360.  
  361.               pident->data.variable.size=size; /* total number of array members */
  362.               pident->data.variable.num=num;   /* number of dimensions */
  363.  
  364.               /* reset the dims array! */
  365.               memset((void *)dims, 0, sizeof(long) * num);
  366.  
  367.               /* reset num: */
  368.               num=1;
  369.  
  370.             } else {
  371. #ifdef DEBUG
  372.               CheckMem(scr, pident);
  373. #endif
  374.  
  375.               GETMEM(pident->data.variable.var.val32, sizeof(long));
  376.               *pident->data.variable.var.val32=0;
  377.               pident->data.variable.num=0;
  378.               pident->data.variable.size=1;
  379.             }
  380.             /*
  381.              * We add the symbol to the local data in all cases except when
  382.              * the symbol is global or static.
  383.              */
  384.             CALL(AddVar(scr, pident,
  385.                         control&(CON_DECLGLOB|CON_DECLSTATIC)?
  386.                         &scr->globals:&scr->locals));
  387.           }
  388.  
  389.           /*
  390.            * Now when all declarations is done, all assigns are left:
  391.            */
  392.  
  393.           expr->flags|=FPL_OPERAND;
  394.           if (pident->flags&FPL_STRING_VARIABLE) { /* string variable */
  395.             if(*scr->text==CHAR_OPEN_BRACKET) { /* just one character */
  396.               /*
  397.                * Get the result of the expression.
  398.                */
  399.               char *value;
  400.               CALL(Expression(val, (scr->text++, scr),
  401.                               CON_GROUNDLVL|CON_NUM, NULL));
  402.               if(*scr->text!=CHAR_CLOSE_BRACKET) {
  403.                 CALL(Warn(scr, FPLERR_MISSING_BRACKET));
  404.                 /* we can continue anyway! */
  405.               } else
  406.                 scr->text++;
  407.  
  408.               CALL(Eat(scr)); /* eat white space */
  409.  
  410.               if(pident->data.variable.num) {
  411.                 /* pick out the proper array member */
  412.                 pos=ArrayNum(num, pident->data.variable.num,
  413.                              dims, pident->data.variable.dims);
  414.                 if(pos<0) {
  415.                   strcpy(scr->buf, pident->name);
  416.                   return FPLERR_ILLEGAL_ARRAY; /* we don't know what was meant! */
  417.                 }
  418.               } else
  419.                 pos=0;
  420.  
  421.               if(&pident->data.variable.var.str[pos] &&
  422.                  (val->val.val >= pident->data.variable.var.str[pos]->len)) {
  423.                 /* force to zero! */
  424.                 val->val.val=0;
  425.               } else if(val->val.val<0) {
  426.                 strcpy(scr->buf, pident->name);
  427.                 return FPLERR_STRING_INDEX; /* we don't know what was meant! */
  428.               }
  429.  
  430.               /*
  431.                * (I) Here we should be able to operate the character read
  432.                * from the string. ++ and -- should work to enable advanced
  433.                * string modification handling without the
  434.                * overhead of getting the string, changing it and then re-
  435.                * assign it back. This *MUST* be implemented soon cause
  436.                * it's a real killer!
  437.                */
  438.  
  439.               value=(char *)&pident->data.variable.var.str[pos]->string[val->val.val];
  440.  
  441.               if(ASSIGN_OPERATOR) {
  442.                 char was=*scr->text;
  443.                 long valint=*value;
  444.                 if(pident->flags&FPL_READONLY)
  445.                   return FPLERR_READONLY_VIOLATE;                  
  446.                 expr->flags|=FPL_ACTION;
  447.                 if(*scr->text==CHAR_ASSIGN)
  448.                   scr->text++;
  449.                 else if(scr->text[2]==CHAR_ASSIGN)
  450.                   scr->text+=3;
  451.                 else
  452.                   scr->text+=2;
  453.                 /* single assign */
  454.                 CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL));
  455.                 CALL(CmpAssign(scr, val->val.val, &valint, FPL_CHAR_VARIABLE, was));
  456.                 *value=valint;
  457.               }
  458.  
  459.               expr->val.val=*value; /* only one byte */
  460.               CALL(NewMember(scr, &expr));
  461.             } else if(control&CON_NUM) {
  462.               /* NO strings allowed! */
  463.               CALL(Warn(scr, FPLERR_UNEXPECTED_STRING_STATEMENT));
  464.               /* be able to continue here, we must pass everything that has to
  465.                  to with the strings in this expression */
  466.             } else if (*scr->text==CHAR_ASSIGN || (*scr->text==CHAR_PLUS &&
  467.                         scr->text[1]==CHAR_ASSIGN)) {
  468.               char array=FALSE;
  469.               char multi=FALSE;
  470.               struct fplStr **string; /* current string */
  471.               char app=(*scr->text==CHAR_PLUS);
  472.  
  473.               if(pident->flags&FPL_READONLY && !(control&CON_DECLARE))
  474.                 return FPLERR_READONLY_VIOLATE;
  475.  
  476.               scr->text+=1+app;
  477.               expr->flags|=FPL_ACTION;
  478.               if(pident->data.variable.num) { /* if array member assign */
  479.                 Eat(scr);
  480.                 if(*scr->text==CHAR_OPEN_BRACE) {
  481.                   /* array assign */
  482.                   multi=TRUE;
  483.                   scr->text++;
  484.                   CALL(Eat(scr));
  485.                 }
  486.                 array=TRUE;
  487.               }
  488.  
  489.               if(!multi) {
  490.                 /* single (array) variable assign */
  491.                 if(array) {
  492.                   pos=ArrayNum(num, pident->data.variable.num,
  493.                                dims, pident->data.variable.dims);
  494.                   if(pos<0) {
  495.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  496.                     pos=0; /* we don't know what was meant! */
  497.                   }
  498.                 } else
  499.                   pos=0;
  500.                 string=&pident->data.variable.var.str[pos];
  501.                 CALL(Expression(val, scr, CON_STRING, NULL));
  502.                 if(!(val->flags&FPL_STRING)) {
  503.                   CALL(Warn(scr, FPLERR_ILLEGAL_ASSIGN));
  504.                 }
  505.                 if(!app && val->flags&FPL_NOFREE) {
  506.                   /*
  507.                    * Only do this this is not an append action _and_
  508.                    * we can't free this string (== someone else is
  509.                    * taking care of this string!)
  510.                    */
  511.                   if(*string) {
  512.                     FREE_KIND(*string); /* free old string */
  513.                   }
  514.                   if(val->val.str) {
  515.                     /* duplicate string */
  516.                     STRFPLDUP((*string), val->val.str);
  517.                   }
  518.                   else
  519.                     *string=NULL;
  520.                 } else {
  521.                   CALL(StrAssign(val->val.str, scr, string, app));
  522.                 }
  523.                 if(*string && MALLOC_STATIC == TypeMem(pident) )
  524.                   SwapMem(scr, *string, MALLOC_STATIC);
  525.                 if(app && !(val->flags&FPL_NOFREE) && val->val.str)
  526.                   /* Only do this if appending! */
  527.                   FREE(val->val.str);
  528. #ifdef STRING_STACK
  529.                 if(app && val->val.str)
  530.                   /* the string couldn't be freed, but we let them know that
  531.                      we don't use it anymore! */
  532.                   val->val.str->flags=FPLSTR_UNUSED;
  533. #endif
  534.               } else {
  535.                 /* multi [compound] assign! */
  536.  
  537.                 /*
  538.                  * Count the preceding open braces to get proper level
  539.                  * to assign in.
  540.                  */
  541.                 while(*scr->text==CHAR_OPEN_BRACE) {
  542.                   num++; /* next dimension */
  543.                   scr->text++; /* pass it! */
  544.                   CALL(Eat(scr));
  545.                 }
  546.  
  547.                 do {
  548.                   while(1) {
  549.                     hit=TRUE;
  550.  
  551.                     /* parse the controlling braces and commas */
  552.                     switch(*scr->text) {
  553.                     case CHAR_CLOSE_BRACE:
  554.  
  555.                       num--; /* back one dimension */
  556.                       if(num>=0 && num<pident->data.variable.num)
  557.                         dims[num]=0;
  558.                       else {
  559.                         CALL(Warn(scr,FPLERR_ILLEGAL_ARRAY));
  560.                         num=0; /* force counter to zero! */
  561.                       }
  562.                       scr->text++;
  563.                       break;
  564.                     case CHAR_COMMA:
  565.                       /*
  566.                        * Increase the last dimension member for next loop:
  567.                        */
  568.  
  569.                       if(num>0 && num<=pident->data.variable.num)
  570.                         dims[num-1]++;
  571.                       else {
  572.                         CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  573.                         /* force counter back to top position! */
  574.                         num=pident->data.variable.num;
  575.                       } scr->text++;
  576.                       break;
  577.                     case CHAR_OPEN_BRACE:
  578.                       num++; /* next dimension */
  579.                       scr->text++;
  580.                       break;
  581.                     default:
  582.                       hit=FALSE;
  583.                       break;
  584.                     }
  585.                     if(hit && !ret) {
  586.                       CALL(Eat(scr));
  587.                     } else
  588.                       break;
  589.                   }
  590.  
  591.  
  592.                   if(!num)
  593.                     break;
  594.  
  595.                   pos=ArrayNum(num, pident->data.variable.num,
  596.                                dims, pident->data.variable.dims);
  597.                   if(pos<0) {
  598.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  599.                     pos=0; /* force back to sane number */
  600.                   }
  601.  
  602.                   /* assign! */
  603.  
  604.                   string=&pident->data.variable.var.str[pos];
  605.  
  606.                   CALL(Expression(val, scr, CON_STRING, NULL));
  607.                   if(!(val->flags&FPL_STRING)) {
  608.                     CALL(Warn(scr, FPLERR_ILLEGAL_ASSIGN));
  609.                   }
  610.  
  611.                   if(!app && val->flags&FPL_NOFREE) {
  612.                     /*
  613.                      * Only do this this is not an append action _and_
  614.                      * we can't free this string (== someone else is
  615.                      * taking care of this string!)
  616.                      */
  617.                     if(*string) {
  618.                       FREE_KIND(*string); /* free old string */
  619.                     }
  620.                     if(val->val.str) {
  621.                       STRFPLDUP((*string), val->val.str); /* duplicate string */
  622.                     }
  623.                     else
  624.                       *string = NULL;
  625.                   } else {
  626.                     CALL(StrAssign(val->val.str, scr, string, app));
  627.                   }
  628.                   if(*string && MALLOC_STATIC == TypeMem(pident))
  629.                     SwapMem(scr, *string, MALLOC_STATIC);
  630.  
  631.                   if(app && !(val->flags&FPL_NOFREE) && val->val.str) {
  632.                     /* only if we're appending! */
  633.                     FREE(val->val.str);
  634.                   }
  635.  
  636. #ifdef STRING_STACK
  637.                   if(app)
  638.                     /* the string couldn't be freed, but we let them know that
  639.                        we don't use it anymore! */
  640.                     val->val.str->flags=FPLSTR_UNUSED;
  641. #endif
  642.                   /* while  */
  643.                 } while(1);
  644.               }
  645.               expr->val.str=*string;
  646.               expr->flags|=FPL_STRING|FPL_NOFREE;
  647.             } else {
  648.               if(control&CON_DECLARE)
  649.                 expr->val.val=0;
  650.               else if(pident->data.variable.num) {
  651.                 pos=ArrayNum(num, pident->data.variable.num,
  652.                              dims, pident->data.variable.dims);
  653.                 if(pos<0) {
  654.                   CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  655.                   pos=0; /* force back to sane number */
  656.                 }
  657.                 expr->val.str=pident->data.variable.var.str[pos];
  658.               } else
  659.                 expr->val.str=pident->data.variable.var.str[0];
  660.               expr->flags|=FPL_STRING|FPL_NOFREE;
  661.             }
  662.           } else {
  663.             /*
  664.              * Integer variable...
  665.              */
  666.             if(control&CON_STRING) {
  667.               /* NO integers allowed! */
  668.               CALL(Warn(scr, FPLERR_UNEXPECTED_INT_STATEMENT));
  669.             }
  670. #if 0
  671.             if(pident->flags&FPL_READONLY && !(control&CON_DECLARE)) {
  672.               if(!pident->data.variable.num)
  673.                 expr->val.val=pident->data.variable.var.val32[0];
  674.               else {
  675.                 pos=ArrayNum(num, pident->data.variable.num,
  676.                              dims, pident->data.variable.dims);
  677.                 if(pos<0) {
  678.                   CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  679.                   pos=0; /* force back to sane number */
  680.                 }
  681.  
  682.                 expr->val.val=pident->data.variable.var.val32[pos];
  683.               }
  684.             } else
  685. #endif
  686.               if(!expr->operator && !expr->unary &&
  687.                       ASSIGN_OPERATOR) {
  688.  
  689.               /* integer assign */
  690.  
  691.               char array=FALSE;    /* is it an array variable */
  692.               char multi=FALSE;    /* mutiple variable */
  693.               char was=*scr->text;
  694.  
  695.               if(pident->flags&FPL_READONLY && !(control&CON_DECLARE))
  696.                 return FPLERR_READONLY_VIOLATE;
  697.  
  698.               expr->flags|=FPL_ACTION;
  699.               if(*scr->text==CHAR_ASSIGN)
  700.                 scr->text++;
  701.               else if(scr->text[2]==CHAR_ASSIGN)
  702.                 scr->text+=3;
  703.               else
  704.                 scr->text+=2;
  705.               if(pident->data.variable.num) { /* if array member assign */
  706.                 Eat(scr);
  707.                 if(*scr->text==CHAR_OPEN_BRACE) {
  708.  
  709.                   /* array assign */
  710.                   multi=TRUE;
  711.                   scr->text++;
  712.                   CALL(Eat(scr));
  713.                 }
  714.                 array=TRUE;
  715.               }
  716.  
  717.               if(!multi) {
  718.                 if(!array)
  719.                   pos=0;
  720.                 else {
  721.                   /* single (array) variable assign */
  722.                   pos=ArrayNum(num, pident->data.variable.num,
  723.                                dims, pident->data.variable.dims);
  724.                   if(pos<0) {
  725.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  726.                     pos=0; /* force back to a decent number */
  727.                   }
  728.                 }
  729.  
  730.                 CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL));
  731.  
  732.                 CALL(CmpAssign(scr, val->val.val,
  733.                                &pident->data.variable.var.val32[pos],
  734.                                pident->flags, was));
  735.                 expr->val.val=pident->data.variable.var.val32[pos];
  736.               } else {
  737.                 /* multi [compound] assign */
  738.  
  739.                 /*
  740.                  * Count the preceding open braces to get proper level
  741.                  * to assign in.
  742.                  */
  743.                 while(*scr->text==CHAR_OPEN_BRACE) {
  744.                   num++; /* next dimension */
  745.                   scr->text++; /* pass it! */
  746.                   CALL(Eat(scr));
  747.                 }
  748.  
  749.                 do {
  750.                   while(1) {
  751.                     char hit=TRUE;
  752.  
  753.                     /* parse the controlling braces and commas */
  754.                     switch(*scr->text) {
  755.                     case CHAR_CLOSE_BRACE:
  756.  
  757.                       num--; /* back one dimension */
  758.                       if(num>=0 && num<pident->data.variable.num)
  759.                         dims[num]=0;
  760.                       else {
  761.                         CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  762.                         num=0;
  763.                       }
  764.                       scr->text++;
  765.                       break;
  766.                     case CHAR_COMMA:
  767.                       /*
  768.                        * Increase the last dimension member for next loop:
  769.                        */
  770.                       if(num>0 && num<=pident->data.variable.num)
  771.                         dims[num-1]++;
  772.                       else {
  773.                         CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  774.                         num=pident->data.variable.num;
  775.                       }
  776.                       scr->text++;
  777.                       break;
  778.                     case CHAR_OPEN_BRACE:
  779.                       num++; /* next dimension */
  780.                       scr->text++;
  781.                       break;
  782.                     default:
  783.                       hit=FALSE;
  784.                       break;
  785.                     }
  786.                     if(hit && !ret) {
  787.                       CALL(Eat(scr));
  788.                     } else
  789.                       break;
  790.                   }
  791.  
  792.                   if(!num)
  793.                     break;
  794.  
  795.                   pos=ArrayNum(num, pident->data.variable.num,
  796.                                dims, pident->data.variable.dims);
  797.                   if(pos<0) {
  798.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  799.                     pos=0;
  800.                   }
  801.  
  802.                   /* assign! */
  803.                   CALL(Expression(val, scr, CON_NORMAL|CON_NUM, NULL));
  804.                   CALL(CmpAssign(scr, val->val.val, &pident->data.variable.var.val32[pos],
  805.                                  pident->flags, was));
  806.                   expr->val.val=pident->data.variable.var.val32[pos];
  807.  
  808.                   /* while  */
  809.                 } while(1);
  810.               }
  811.               expr->flags|=FPL_NOFREE; /* the memory pointed to by the expr->val.val
  812.                                           is strings of proper variables. Do
  813.                                           not free them now! */
  814.             } else {
  815.               /*
  816.                * No assignment, primary operator or none at all!
  817.                */
  818.               long *value;
  819.               if(control&CON_DECLARE)
  820.                 expr->val.val=0;
  821.               else {
  822.                 if(pident->data.variable.num) {
  823.                   pos=ArrayNum(num, pident->data.variable.num,
  824.                                dims, pident->data.variable.dims);
  825.                   if(pos<0) {
  826.                     CALL(Warn(scr, FPLERR_ILLEGAL_ARRAY));
  827.                     pos=0;
  828.                   }
  829.                 } else
  830.                   pos=0;
  831.                 value=&pident->data.variable.var.val32[pos];
  832.  
  833.                 if(*point==CHAR_PLUS && point[1]==CHAR_PLUS) {
  834.                   /*post increment*/
  835.                   if(pident->flags&FPL_READONLY)
  836.                     return FPLERR_READONLY_VIOLATE;                  
  837.                   expr->flags|=FPL_ACTION;
  838.                   expr->val.val=(*value)++;
  839.                   scr->text+=2;
  840.                 } else if(*point==CHAR_MINUS && point[1]==CHAR_MINUS) {
  841.                   /* post decrement */
  842.                   if(pident->flags&FPL_READONLY)
  843.                     return FPLERR_READONLY_VIOLATE;                  
  844.  
  845.                   expr->flags|=FPL_ACTION;
  846.                   expr->val.val=(*value)--;
  847.                   scr->text+=2;
  848.                 } else {
  849.                   /* plain variable or pre operation */
  850.                   if(un=expr->unary) {
  851.                     if(un->unary!=OP_PREINC && un->unary!=OP_PREDEC) {
  852.                       expr->val.val=*value;
  853.                     } else {
  854.                       if(pident->flags&FPL_READONLY)
  855.                         return FPLERR_READONLY_VIOLATE;
  856.                       if(un->unary==OP_PREINC)
  857.                         expr->val.val=++(*value);
  858.                       else
  859.                         expr->val.val=--(*value);
  860.                       expr->unary=un->next;
  861.                       FREE(un);
  862.                     }
  863.                   } else
  864.                     expr->val.val=*value;
  865.                 }
  866.                 if(pident->flags&FPL_VARIABLE_LESS32) {
  867.                   if(pident->flags&FPL_CHAR_VARIABLE) {
  868.                     expr->val.val=(long)((signed char)expr->val.val);
  869.                     *value=(long)((signed char)*value);
  870.                   } else {
  871.                     /* sixteen bits */
  872.                     expr->val.val=(long)((signed short)expr->val.val);
  873.                     *value=(long)((signed short)*value);
  874.                   }
  875.                 }
  876.               }
  877.               CALL(NewMember(scr, &expr));
  878.             }
  879.           }   /* end of integer handling */
  880.         } else if(ret && (*scr->text!=CHAR_OPEN_PAREN))
  881.           return(ret); /* FPLERR_IDENTIFIER_NOT_FOUND */
  882.         else {                     /* some sort of function */
  883.           /*
  884.            * FUNCTION HANDLER PART:
  885.            */
  886.  
  887.           struct fplArgument *pass; /* struct pointer to send as argument to
  888.                                        the function handler */
  889.           long allocspace;
  890.  
  891.           if(ret) {
  892.             if(!(scr->flags&FPLDATA_ALLFUNCTIONS) ||
  893.                *scr->text!=CHAR_OPEN_PAREN)
  894.               /* If the ability to parse all functions isn't turned on, or if
  895.                  the following character is not an open parenthesis, fail! */
  896.               return(ret);
  897.           }
  898.  
  899.           num=0;    /* number of arguments */
  900.  
  901.           expr->flags|=FPL_OPERAND|FPL_ACTION; /* This sure is action...! */
  902.  
  903.           GETMEM(pass, sizeof(struct fplArgument));
  904.  
  905.           if(!ident) {
  906.             /* The function does not exist as a declared function! */
  907.             STRDUP(pass->name, scr->buf);
  908.             pass->ID=FPL_UNKNOWN_FUNCTION;
  909.             text="o>"; /* optional parameter list as argument! */
  910.           } else {
  911.             pass->name=ident->name;
  912.             pass->ID=ident->data.external.ID;
  913.             text=ident->data.inside.format;
  914.           }
  915.           pass->argc=0;
  916.           pass->key=(void *)scr;
  917.  
  918.           if(!ident || FPL_OPTEXPRARG == ident->data.inside.ret) {
  919.             /*
  920.              * The function we invoked was not found regularly!
  921.          * Set return type!
  922.          */
  923.  
  924.         /*
  925.              * We try to determine whether it should return an int or a string.
  926.              * We interpret the return value as we should do to make it pass
  927.              * as a valid expression. That is, if the flag tells us this
  928.              * should be a string expression to be valid, we take it as a
  929.              * string, but if it tells us its an integer expression, we read
  930.              * it as an integer!!!
  931.              */
  932.  
  933.             if(control&CON_STRING)
  934.               hit = FPL_STRARG;
  935.             else {
  936.               if(control&CON_NUM)
  937.                 hit = FPL_INTARG;
  938.               else
  939.                 /*
  940.                  * We don't know which kind of return code the function
  941.                  * should give us!
  942.                  */
  943.                 hit = FPL_OPTEXPRARG;
  944.             }
  945.  
  946.       } else {
  947.             hit = UPPER(ident->data.inside.ret);
  948.             if(control&CON_STRING && (hit!=FPL_STRARG))
  949.               return FPLERR_UNEXPECTED_INT_STATEMENT;
  950.             if(control&CON_NUM && (hit!=FPL_INTARG))
  951.               return FPLERR_UNEXPECTED_STRING_STATEMENT;
  952.           }
  953.  
  954.           pass->ret = hit;
  955.  
  956.           if(*scr->text!=CHAR_OPEN_PAREN) {
  957.             CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));  /* >warning< */
  958.           } else
  959.             scr->text++;
  960.  
  961.           CALL(Eat(scr));
  962.  
  963.           if(text && *text) {
  964.             unsigned char b='a';
  965.             unsigned char a;
  966.  
  967.             /* if the function takes arguments */
  968.  
  969.             /*
  970.              * Allocate arrays to use for data storage while parsing
  971.              * the arguments. Maximum number of arguments is
  972.              * MAX_ARGUMENTS.
  973.              */
  974.  
  975.             num=strlen(text);   /* number of arguments to this function */
  976.  
  977.             if(text[num-1]!=FPL_ARGLIST)
  978.               allocspace=num+1;
  979.             else
  980.               allocspace=MAX_ARGUMENTS;
  981.  
  982.             /*
  983.              * By adjusting the number of allocated bytes to the smallest
  984.              * necessary, my recursive example program used only a fifth
  985.              * as much memory as when always allocating memory for
  986.              * MAX_ARGUMENTS.
  987.              */
  988.  
  989.             /* allocate an array */
  990.             GETMEM(pass->argv, sizeof(char *)*allocspace);
  991.  
  992.             /* allocate new format string */
  993.             GETMEM(pass->format, sizeof(char)*allocspace);
  994.  
  995.             /* allocate allocate-flag string */
  996.             GETMEM(array, sizeof(char)*allocspace);
  997.  
  998.             while(!ret && *scr->text!=CHAR_CLOSE_PAREN && text && *text) {
  999.               b=(*text==FPL_ARGLIST)?b:UPPER(*text);
  1000.           if(FPL_OPTARG == b &&
  1001.          CHAR_AND == scr->text[0])
  1002.                 a = FPL_OPTVARARG;
  1003.           else
  1004.                 a = b;
  1005.  
  1006.               if(pass->argc==allocspace) {
  1007.                 char *temp;
  1008.                 GETMEM(temp, sizeof(char *)*(allocspace+MAX_ARGUMENTS));
  1009.                 memcpy(temp, pass->argv, sizeof(char *)*allocspace);
  1010.                 FREE(pass->argv);
  1011.                 pass->argv=(void **)temp;
  1012.  
  1013.                 GETMEM(temp, sizeof(char)*(allocspace+MAX_ARGUMENTS));
  1014.                 memcpy(temp, pass->format, sizeof(char)*allocspace);
  1015.                 FREE(pass->format);
  1016.                 pass->format=temp;
  1017.  
  1018.                 GETMEM(temp, sizeof(char)*(allocspace+MAX_ARGUMENTS));
  1019.                 memcpy(temp, array, sizeof(char)*allocspace);
  1020.                 FREE(array);
  1021.                 array=temp;
  1022.                 
  1023.                 allocspace += MAX_ARGUMENTS;
  1024.               }
  1025.  
  1026.               switch(a) {
  1027.           case FPL_OPTEXPRARG:
  1028.               case FPL_OPTARG:
  1029.               case FPL_STRARG:
  1030.                 CALL(Expression(val, scr, (a==FPL_STRARG?CON_STRING:0), NULL));
  1031.                 if(a==FPL_STRARG && !(val->flags&FPL_STRING)) {
  1032.                   CALL(Warn(scr, FPLERR_ILLEGAL_PARAMETER));
  1033.                 }
  1034.  
  1035.                 if(a==FPL_STRARG || val->flags&FPL_STRING) {
  1036.  
  1037.                   /* Enter string symbol in the created format string! */
  1038.                   pass->format[pass->argc]=FPL_STRARG;
  1039.  
  1040.                   if(val->val.str) {
  1041.                     /* Set this to TRUE if deallocation is wanted on this
  1042.                        string after the function call! */
  1043.                     array[pass->argc]=!(val->flags&FPL_NOFREE);
  1044.                     /*
  1045.                      * Point to the string (that is zero terminated)!
  1046.                      */
  1047.                     pass->argv[pass->argc]=val->val.str->string;
  1048.                   } else {
  1049.                     GETMEM(string, sizeof(struct fplStr));
  1050.             memset(string, 0, sizeof(struct fplStr));
  1051.             pass->argv[pass->argc]=string->string;
  1052.                     array[pass->argc]=1; /* allocation has been done! */
  1053.                   }
  1054.                 } else {
  1055.                   pass->format[pass->argc]=FPL_INTARG;
  1056.                   pass->argv[pass->argc]=(void *)val->val.val;
  1057.                 }
  1058.                 pass->argc++;
  1059.                 break;
  1060.               case FPL_INTARG:
  1061.                 CALL(Expression(val, scr, CON_NUM, NULL));
  1062.                 pass->format[pass->argc]=FPL_INTARG;
  1063.                 pass->argv[pass->argc++]=(void *)val->val.val;
  1064.                 break;
  1065.           case FPL_OPTVARARG:
  1066.               case FPL_STRVARARG:
  1067.               case FPL_INTVARARG:
  1068.           case FPL_INTARRAYVARARG:
  1069.           case FPL_STRARRAYVARARG:
  1070.         if(*scr->text != CHAR_AND) {
  1071.             hit = FPLERR_ILLEGAL_REFERENCE;
  1072.             }
  1073.         else {
  1074.             scr->text++;
  1075.             hit = FPL_OK;
  1076.         }
  1077.                 CALL(Getword(scr));
  1078.                 /* Use the `pident' pointer here, cause the `ident' pointer
  1079.                    is already being used by the function we're about to
  1080.                    invoke! */
  1081.                 CALL(GetIdentifier(scr, scr->buf, &pident));
  1082.  
  1083.         if(hit) {
  1084.             /* missing &-character! */
  1085.             if(pident->flags&FPL_REFERENCE)
  1086.                       /* get the referenced variable instead! */
  1087.                       pident = pident->data.variable.ref;
  1088.             else
  1089.             return FPLERR_ILLEGAL_REFERENCE; /* no reference! */
  1090.         }
  1091.  
  1092.         if(FPL_INTARRAYVARARG == a || FPL_STRARRAYVARARG == a) {
  1093.             if(!pident->data.variable.num)
  1094.             return FPLERR_ILLEGAL_REFERENCE;
  1095.         }
  1096.         else if(FPL_OPTVARARG != a && pident->data.variable.num)
  1097.             /* only straight variables! */
  1098.             return FPLERR_ILLEGAL_PARAMETER;
  1099.  
  1100.                 if( (pident->flags&FPL_INT_VARIABLE &&
  1101.              (a==FPL_STRVARARG || a == FPL_STRARRAYVARARG)) ||
  1102.            (pident->flags&FPL_STRING_VARIABLE &&
  1103.             (a==FPL_INTVARARG || a == FPL_INTARRAYVARARG))) {
  1104.             CALL(Warn(scr, FPLERR_ILLEGAL_VARIABLE));
  1105.             /* can't copy wrong variable! */
  1106.             pass->argv[pass->argc]=NULL;
  1107.                 } else
  1108.             pass->argv[pass->argc]=(void *)pident;
  1109.  
  1110.                 pass->format[pass->argc++]=
  1111.           (pident->flags&FPL_STRING?
  1112.          (pident->data.variable.num?FPL_STRARRAYVARARG:FPL_STRVARARG):
  1113.            (pident->data.variable.num?FPL_INTARRAYVARARG:
  1114.             FPL_INTVARARG));
  1115.                 Eat(scr);
  1116.                 break;
  1117.               default:
  1118.                 CALL(Warn(scr, FPLERR_ILLEGAL_PARAMETER));
  1119.                 break; /* just ignore it and be happy! */
  1120.               }
  1121.               if(*text!=FPL_ARGLIST)
  1122.                 text++;
  1123.               if(*scr->text==CHAR_COMMA) {
  1124.                 scr->text++;
  1125.         CALL(Eat(scr)); /* eat white space! */
  1126.  
  1127.               }
  1128.             }
  1129.             pass->format[pass->argc]=CHAR_ASCII_ZERO;
  1130.             if(text && *text && !(*text&CASE_BIT)) {
  1131.               return FPLERR_MISSING_ARGUMENT;
  1132.               /*
  1133.                * This is a serious mis-use. The function is called with to few
  1134.                * parameters. At least one parameter missing is a required one.
  1135.                * I really can't figure out a way to survive such a shock!
  1136.                */
  1137.             }
  1138.           } else
  1139.             pass->format=NULL;
  1140.           if(*scr->text!=CHAR_CLOSE_PAREN) {
  1141.             CALL(Warn(scr, FPLERR_TOO_MANY_PARAMETERS)); /* too many parameters! */
  1142.             /* It's ok to continue without the parenthesis! */
  1143.           } else
  1144.             scr->text++;
  1145.  
  1146.           /*
  1147.            * Call the function!
  1148.            */
  1149.  
  1150.           CALL(CallFunction(scr, pass, ident));
  1151.  
  1152.           if(!ident) {
  1153.             /*
  1154.              * The function we invoked was not found regularly!
  1155.          * Free the name we allocated temporarily and set
  1156.          * return type to optional!
  1157.          */
  1158.             FREE(pass->name); /* the name was strdup()'ed! */
  1159.       }
  1160.  
  1161.           if(FPL_OPTEXPRARG == hit) {
  1162.  
  1163.             CALL(GetMessage(scr, FPLMSG_RETURN_INT, &msg));
  1164.             if(!msg) {
  1165.               /* There is no 'int' return. Check if there is any 'string'
  1166.                  return, otherwise say it is an 'int' anyway! */
  1167.               CALL(GetMessage(scr, FPLMSG_RETURN_STRING, &msg));
  1168.               if(!msg)
  1169.                 /* no string either, default to int! */
  1170.                 hit = FPL_INTARG;
  1171.               else
  1172.                 /* found string, it returned a 'string' !!! */
  1173.                 hit = FPL_STRARG;
  1174.             } else {
  1175.               /* There is a return 'int' message! This may well be a
  1176.                  function returning int! */
  1177.               hit = FPL_INTARG;
  1178.             }
  1179.  
  1180.           }
  1181.  
  1182.           if(hit==FPL_STRARG)
  1183.             /* if the return value should be a string: */
  1184.             HandleString(scr, expr);
  1185.           else {
  1186.             /* only if integer! or the function is non-existent */
  1187.             CALL(GetMessage(scr, FPLMSG_RETURN_INT, &msg));
  1188.             expr->val.val=(msg?(long)msg->message[0]:0);
  1189.             CALL(NewMember(scr, &expr));
  1190.             if(msg)
  1191.               CALL(DeleteMessage(scr, msg));
  1192.           }
  1193.           while(pass->argc--) {
  1194.             if(pass->format[pass->argc]==FPL_STRARG && array[pass->argc]) {
  1195.               /* free the string if it's been marked to be freed!! */
  1196.               FREE((char *)pass->argv[pass->argc]-
  1197.                    offsetof(struct fplStr, string));
  1198.             }
  1199.           }
  1200.           if(pass->format) {
  1201.             FREE(pass->argv);
  1202.             FREE(pass->format);
  1203.             FREE(array);
  1204.           }
  1205.           FREE(pass);
  1206.         }
  1207.       } else {
  1208.  
  1209.           pos=0;
  1210.           switch(*scr->text) {
  1211.       case CHAR_MULTIPLY:
  1212.         /*
  1213.          * This is the 'contents of' operator!
  1214.          * The contents of the variable that follows this sign should
  1215.          * get the following rvalue.
  1216.          * Of course, we must first check that this really is a
  1217.          * 'pointer' to a variable.
  1218.          * If we declare this, make sure that it doesn't point to
  1219.          * anything at all!
  1220.          */
  1221.  
  1222.         while(*++scr->text==CHAR_MULTIPLY); /* just in case! */
  1223.  
  1224.         CALL(Getword(scr));
  1225.         if(control&CON_DECLARE) {
  1226.           return FPLERR_SYNTAX_ERROR; /* not yet supported */
  1227.         }
  1228.         else {
  1229.               CALL(GetIdentifier(scr, scr->buf, &ident));
  1230.           if(!(ident->flags&FPL_REFERENCE))
  1231.             return FPLERR_ILLEGAL_REFERENCE; /* referenced a non-reference! */
  1232.           if(!ident->data.variable.ref)
  1233.         return FPLERR_ILLEGAL_REFERENCE; /* illegal reference! */
  1234.  
  1235.           ident = ident->data.variable.ref; /* use the "actual" variable! */
  1236.  
  1237.           /* we have an identifier and the level is OK! */
  1238.           control |= CON_IDENT|CON_LEVELOK;
  1239.           continue; /* now we have the pointer for the *real* variable! */
  1240.         }
  1241.         break;
  1242.           case CHAR_ZERO:
  1243.             /*
  1244.              * Numbers starting with a '0' can be hex/oct/bin.
  1245.              */
  1246.             if(control&CON_STRING) {
  1247.               /* NO integers allowed! */
  1248.               return FPLERR_UNEXPECTED_INT_STATEMENT;
  1249.             }
  1250.             switch(scr->text[1]) {
  1251.             case CHAR_X:
  1252.             case CHAR_UPPER_X:
  1253.               /* hexadecimal number parser */
  1254.               for(scr->text+=2; isxdigit(*scr->text); scr->text++)
  1255.                 expr->val.val=expr->val.val*16+ (isdigit(*scr->text)?
  1256.                                          *scr->text-CHAR_ZERO:
  1257.                                          UPPER(*scr->text)-CHAR_UPPER_A+10);
  1258.               break;
  1259.             case CHAR_B:
  1260.             case CHAR_UPPER_B:
  1261.               /* binary number parser */
  1262.               for(scr->text+=2;*scr->text==CHAR_ZERO || *scr->text==CHAR_ONE;)
  1263.                 expr->val.val=expr->val.val*2+ *scr->text++ - CHAR_ZERO;
  1264.               break;
  1265.             case CHAR_ZERO:
  1266.             case CHAR_ONE:
  1267.             case CHAR_TWO:
  1268.             case CHAR_THREE:
  1269.             case CHAR_FOUR:
  1270.             case CHAR_FIVE:
  1271.             case CHAR_SIX:
  1272.             case CHAR_SEVEN:
  1273.               /* octal number parser */
  1274.               for(scr->text++; isodigit(*scr->text);)
  1275.                 expr->val.val=expr->val.val*8+ *scr->text++ - CHAR_ZERO;
  1276.               break;
  1277.             default:
  1278.               /* a single zero is simply 0 */
  1279.               scr->text++;
  1280.               expr->val.val=0;
  1281.               break;
  1282.             }
  1283.             CALL(NewMember(scr, &expr));
  1284.             break;
  1285.         /* end of case CHAR_ZERO: */
  1286.  
  1287.           case CHAR_ONE:
  1288.           case CHAR_TWO:
  1289.           case CHAR_THREE:
  1290.           case CHAR_FOUR:
  1291.           case CHAR_FIVE:
  1292.           case CHAR_SIX:
  1293.           case CHAR_SEVEN:
  1294.           case CHAR_EIGHT:
  1295.           case CHAR_NINE:
  1296.             /*
  1297.              * We hit a number between 1 and 9.
  1298.              */
  1299.             if(control&CON_STRING) {
  1300.               /* NO integers allowed! */
  1301.               CALL(Warn(scr, FPLERR_UNEXPECTED_INT_STATEMENT));
  1302.             }
  1303.             do
  1304.               expr->val.val= expr->val.val*10 + *scr->text++ - CHAR_ZERO;
  1305.             while(isdigit(*scr->text));
  1306.             CALL(NewMember(scr, &expr));
  1307.         break;
  1308.  
  1309.         case CHAR_QUOTATION_MARK:
  1310.             if(control&CON_NUM) {
  1311.               /* NO integers allowed! */
  1312.               CALL(Warn(scr, FPLERR_UNEXPECTED_STRING_STATEMENT));
  1313.             }
  1314.             CALL(Convert(val, scr));
  1315.             /* This returned a string! */
  1316.             expr->val.str=val->val.str;
  1317.             expr->flags=FPL_STRING;
  1318.         break;
  1319.  
  1320.         case CHAR_APOSTROPHE:
  1321.             /*
  1322.              * Apostrophes surround character. Returns ASCII code.
  1323.              */
  1324.             if(control&CON_STRING) {
  1325.               /* NO integers allowed! */
  1326.               CALL(Warn(scr, FPLERR_UNEXPECTED_INT_STATEMENT));
  1327.             }
  1328.             CALL(ReturnChar((scr->text++, scr), &expr->val.val, FALSE));
  1329.             if(*scr->text!=CHAR_APOSTROPHE) {
  1330.               CALL(Warn(scr, FPLERR_MISSING_APOSTROPHE)); /* >warning< */
  1331.               /* just continue as nothing has ever happened! */
  1332.             } else
  1333.               scr->text++;
  1334.             CALL(NewMember(scr, &expr));
  1335.         break;
  1336.  
  1337.         case CHAR_OPEN_PAREN:
  1338.             CALL(Expression(val, (++scr->text, scr), CON_GROUNDLVL|CON_NUM, NULL));
  1339.             if(*scr->text!=CHAR_CLOSE_PAREN) {
  1340.               CALL(Warn(scr, FPLERR_MISSING_PARENTHESES)); /* >warning< */
  1341.               /* Go on anyway! */
  1342.             } else
  1343.               scr->text++;
  1344.             expr->val.val=val->val.val;
  1345.             CALL(NewMember(scr, &expr));
  1346.             break;
  1347.  
  1348.         case CHAR_NOT_OPERATOR:
  1349.             CALL(AddUnary(scr, expr, OP_NOT));
  1350.             ++scr->text;
  1351.             break;
  1352.  
  1353.         case CHAR_ONCE_COMPLEMENT:
  1354.             CALL(AddUnary(scr, expr, OP_COMPL));
  1355.             ++scr->text;
  1356.           break;
  1357.  
  1358.         case CHAR_PLUS:
  1359.             if(scr->text[1]==CHAR_PLUS) {
  1360.               expr->flags|=FPL_ACTION;
  1361.               scr->text+=2;
  1362.               CALL(AddUnary(scr, expr, OP_PREINC));
  1363.             } else {
  1364.               CALL(AddUnary(scr, expr, OP_PLUS));
  1365.               scr->text++;
  1366.             }
  1367.             break;
  1368.  
  1369.         case CHAR_MINUS:
  1370.             if(scr->text[1]==CHAR_MINUS) {
  1371.               expr->flags|=FPL_ACTION;
  1372.               scr->text+=2;
  1373.               CALL(AddUnary(scr, expr, OP_PREDEC));
  1374.             } else {
  1375.               CALL(AddUnary(scr, expr, OP_MINUS));
  1376.               scr->text++;
  1377.             }
  1378.             break;
  1379.  
  1380.           default:
  1381.  
  1382.             if((*scr->text==CHAR_SEMICOLON && control&CON_SEMICOLON) ||
  1383.                (*scr->text==CHAR_CLOSE_PAREN && control&CON_PAREN)
  1384.                && basexpr==expr && expr->operator==OP_NOTHING) {
  1385.               /* for(;;) support.
  1386.                  There must not have been a previous operand or operator */
  1387.               pos=expr->val.val=TRUE;
  1388.             } else {   /* no operand results in error! */
  1389.               CALL(Warn(scr, FPLERR_MISSING_OPERAND)); /* WARNING! */
  1390.               expr->operator=OP_NOTHING; /* reset */
  1391.             }
  1392.           break;
  1393.         }
  1394.         if(pos)
  1395.           break;
  1396.       }
  1397.  
  1398.     } else {                                         /* waiting for operator */
  1399.       char *point=scr->text;
  1400.  
  1401.       switch(*scr->text) {
  1402.       case CHAR_ASSIGN:
  1403.         if(scr->text[1]==CHAR_ASSIGN) {
  1404.           expr->operator=OP_EQUAL;
  1405.           scr->text+=2;
  1406.         }
  1407.         break;
  1408.       case CHAR_AND:
  1409.     if(scr->text[1]==CHAR_AND) {
  1410.           /*
  1411.            * This is a logical AND (&&)
  1412.            */
  1413.           scr->text+=2;
  1414.  
  1415.           /*
  1416.            * Get result from everything to the left of this!
  1417.            */
  1418.           CALL(Calc(scr, val, basexpr));
  1419.  
  1420.           /*
  1421.            * Clean the expression so far.
  1422.            */
  1423.           Clean(scr, basexpr);    /* erase the list */
  1424.  
  1425.           /*
  1426.            * Start a new list with this result
  1427.            */
  1428.           GETMEM(expr, sizeof(struct Expr));
  1429.           memset(expr, 0, sizeof(struct Expr));
  1430.           basexpr=expr;
  1431.           expr->val.val = val->val.val;
  1432.  
  1433.           if(!expr->val.val) {
  1434.             /*
  1435.              * In this case, its like in the 'a && b' expression and 'a'
  1436.              * equals 0. Then we should skip the 'b' expression.
  1437.              */
  1438.             CALL(ScanForNext(scr, OP_LOGAND));
  1439.             expr->flags = FPL_OPERAND;
  1440.           }
  1441.           continue;
  1442.  
  1443.         } else {
  1444.           expr->operator=OP_BINAND;
  1445.           scr->text++;
  1446.         }
  1447.         break;
  1448.       case CHAR_OR:
  1449.         if(scr->text[1]==CHAR_OR) {
  1450.           /*
  1451.            * This is a logical OR operator (||)
  1452.            */
  1453.           scr->text+=2;
  1454.  
  1455.           /*
  1456.            * Get result from everything to the left of this!
  1457.            */
  1458.           CALL(Calc(scr, val, basexpr));
  1459.  
  1460.           /*
  1461.            * Clean the expression so far.
  1462.            */
  1463.           Clean(scr, basexpr);    /* erase the list */
  1464.  
  1465.           /*
  1466.            * Start a new list with this result
  1467.            */
  1468.           GETMEM(expr, sizeof(struct Expr));
  1469.           memset(expr, 0, sizeof(struct Expr));
  1470.           basexpr=expr;
  1471.           expr->val.val = val->val.val;
  1472.  
  1473.           if(expr->val.val) {
  1474.             /*
  1475.              * In this case, its like in the 'a || b' expression and 'a'
  1476.              * equals 1. Then we should skip the 'b' expression.
  1477.              */
  1478.             CALL(ScanForNext(scr, OP_LOGOR));
  1479.             expr->flags = FPL_OPERAND;
  1480.           }
  1481.           continue;
  1482.  
  1483.         } else {
  1484.           expr->operator=OP_BINOR;
  1485.           scr->text++;
  1486.         }
  1487.         break;
  1488.       case CHAR_PLUS:
  1489.         expr->operator=OP_PLUS;
  1490.         ++scr->text;
  1491.         break;
  1492.       case CHAR_MINUS:
  1493.         expr->operator=OP_MINUS;
  1494.         ++scr->text;
  1495.         break;
  1496.       case CHAR_QUESTION:
  1497.         ++scr->text;
  1498.         /*
  1499.          * This is the first operator in a conditional operator sequence (?)
  1500.          */
  1501.  
  1502.         /*
  1503.          * Get result from everything to the left of this!
  1504.          */
  1505.         CALL(Calc(scr, val, basexpr));
  1506.  
  1507.         /*
  1508.          * Clean the expression so far.
  1509.          */
  1510.         Clean(scr, basexpr);    /* erase the list */
  1511.  
  1512.         /*
  1513.          * Start a new list with this result
  1514.          */
  1515.         GETMEM(expr, sizeof(struct Expr));
  1516.         memset(expr, 0, sizeof(struct Expr));
  1517.         expr->flags = FPL_OPERAND;
  1518.         basexpr=expr;
  1519.  
  1520.         if(val->val.val) {
  1521.           /*
  1522.            * In this case, its like in the 'a ? b : c' expression and 'a'
  1523.            * equals 1. Then we should skip the 'c' expression.
  1524.            */
  1525.           CALL(Expression(val, scr, CON_NORMAL, NULL));
  1526.           if(*scr->text++!=CHAR_COLON)
  1527.             return FPLERR_ILLEGAL_CONDOP;
  1528.           CALL(ScanForNext(scr, OP_COND2));          
  1529.         }
  1530.         else {
  1531.           /*
  1532.            * In this case, its like in the 'a ? b : c' expression and 'a'
  1533.            * equals 0. Then we should skip the 'b' expression.
  1534.            */
  1535.           CALL(ScanForNext(scr, OP_COND1));
  1536.           if(*scr->text++!=CHAR_COLON)
  1537.             return FPLERR_ILLEGAL_CONDOP;
  1538.           CALL(Expression(val, scr, CON_NORMAL, NULL));
  1539.         }
  1540.         expr->val.val = val->val.val;
  1541.         continue; /* check for next operator */
  1542.  
  1543.         break;
  1544. #if 0
  1545.       case CHAR_COLON:
  1546.         if(conditional) {
  1547.           /* only if preceeded with the regular '?' operator! */
  1548.       conditional--;
  1549.           expr->operator=OP_COND2;
  1550.           ++scr->text;
  1551.         }
  1552.         break;
  1553. #endif
  1554.       case CHAR_MULTIPLY:
  1555.         expr->operator=OP_MULTIPLY;
  1556.         ++scr->text;
  1557.         break;
  1558.       case CHAR_DIVIDE:
  1559.         expr->operator=OP_DIVISION;
  1560.         ++scr->text;
  1561.         break;
  1562.       case CHAR_REMAIN:
  1563.         expr->operator=OP_REMAIN;
  1564.         ++scr->text;
  1565.         break;
  1566.       case CHAR_XOR:
  1567.         expr->operator=OP_BINXOR;
  1568.         ++scr->text;
  1569.         break;
  1570.       case CHAR_LESS_THAN:
  1571.         if(scr->text[1]==CHAR_ASSIGN) {
  1572.           scr->text+=2;
  1573.           expr->operator=OP_LESSEQ;
  1574.         } else if(scr->text[1]==CHAR_LESS_THAN) {
  1575.           scr->text+=2;
  1576.           expr->operator=OP_SHIFTL;
  1577.         } else {
  1578.           scr->text++;
  1579.           expr->operator=OP_LESS;
  1580.         }
  1581.         break;
  1582.       case CHAR_GREATER_THAN:
  1583.     if(scr->text[1]==CHAR_ASSIGN) {
  1584.           expr->operator= OP_GRETEQ;
  1585.           scr->text+=2;
  1586.         } else if(scr->text[1]==CHAR_GREATER_THAN) {
  1587.           scr->text+=2;
  1588.           expr->operator=OP_SHIFTR;
  1589.         } else {
  1590.           scr->text++;
  1591.           expr->operator=OP_GRET;
  1592.         }
  1593.         break;
  1594.       case CHAR_NOT_OPERATOR:
  1595.         if(scr->text[1]==CHAR_ASSIGN) {
  1596.           expr->operator=OP_NOTEQ;
  1597.           scr->text+=2;
  1598.         }
  1599.         break;
  1600.       case CHAR_COMMA:
  1601.         if(control&CON_GROUNDLVL) {
  1602.           Clean(scr, basexpr);
  1603.           GETMEM(basexpr, sizeof(struct Expr));
  1604.           expr=basexpr;
  1605.           expr->val.val=0;
  1606.           expr->unary=NULL;
  1607.           expr->operator=expr->flags=OP_NOTHING;
  1608.           expr->next=NULL;
  1609.           scr->text++;
  1610.         }
  1611.         break;
  1612.       }
  1613.       if(point==scr->text)
  1614.         break;
  1615.       expr->flags&=~FPL_OPERAND; /* clear the operand bit */
  1616.     }
  1617.   }
  1618.  
  1619.   if(!(control&(CON_DECLARE /* |CON_ACTION */ ))) {
  1620.     /*
  1621.      * Get result of the current expression only if this isn't called
  1622.      * as a declaring (no one wants the return code from 'int a'!)
  1623.      * or a stand-alone (they have no receiver anyway) statement.
  1624.      */
  1625.     CALL(Calc(scr, val, basexpr));
  1626.  
  1627.     /*
  1628.      * If this was a stand alone statement, including no action returns an
  1629.      * error!
  1630.      */
  1631.     if(control&CON_ACTION && !(val->flags&FPL_ACTION)) {
  1632.       CALL(Warn(scr, FPLERR_NO_ACTION));
  1633.       /* but we can just as good keep on anyway! */
  1634.     }
  1635.   }
  1636.  
  1637.   Clean(scr, basexpr);    /* erase the rest of the list */
  1638.   if(dims)
  1639.     FREE(dims);
  1640.   return(FPL_OK);
  1641. }
  1642.  
  1643. /**********************************************************************
  1644.  *
  1645.  * ReturnCode Calc();
  1646.  *
  1647.  * Returns the result in the first Expr struct of the expression that
  1648.  * the second parameter holds. This function does not free the expression
  1649.  * list.
  1650.  *
  1651.  *******/
  1652.  
  1653. static ReturnCode
  1654. Calc(struct Data *scr,
  1655.      struct Expr *val,
  1656.      struct Expr *basexpr)
  1657. {
  1658.   /* lower value=higher priority. Order as the operator list in script.h:
  1659.    *|    +  -  /  * << >>  %  &  |  ^ && ||  ~    ?   :  == <= >=  <  > != ! */
  1660.   const static unsigned char priority[]={
  1661.     255, 1, 1, 0, 0, 2, 2, 0, 5, 7, 6, 8, 9, 255, 10, 10, 4, 3, 3, 3, 3, 4, 255
  1662.     };
  1663.  
  1664.   ReturnCode ret;
  1665.   unsigned char pri, minpri=255, maxpri=0;
  1666.   struct Expr *expr=basexpr, *last;
  1667.   struct Unary *un, *next;
  1668.  
  1669.   /* first all Unary expressions */
  1670.   if(!(expr->flags&FPL_STRING)) {
  1671.     while(expr) {
  1672.       if(priority[expr->operator]<minpri)
  1673.         minpri=priority[expr->operator]; /* get the lowest priority */
  1674.       if(priority[expr->operator]>maxpri && expr->operator!=OP_NOTHING)
  1675.         maxpri=priority[expr->operator]; /* get the highest priority */
  1676.       if(expr->flags&FPL_STRING) {
  1677.         CALL(Warn(scr, FPLERR_ILLEGAL_VARIABLE));
  1678.         /*
  1679.          * A string among the integers!
  1680.          * We remove this and try next!
  1681.          */
  1682.  
  1683.         last=expr->next;
  1684.         FREE(expr); /* delete this bastard from the expression!!! */
  1685.         expr=last;
  1686.       } else {
  1687.         un=expr->unary;
  1688.         while(un) {
  1689.           switch(un->unary) {
  1690.           case OP_NOT:
  1691.             expr->val.val=!expr->val.val;
  1692.             break;
  1693.           case OP_COMPL:
  1694.             expr->val.val=~expr->val.val;
  1695.             break;
  1696.           case OP_MINUS:
  1697.             expr->val.val=-expr->val.val;
  1698.             break;
  1699.             /*simply ignored!
  1700.               case OP_PLUS:
  1701.               break;
  1702.               */
  1703.           case OP_PREDEC:
  1704.           case OP_PREINC:
  1705.             CALL(Warn(scr, FPLERR_ILLEGAL_PREOPERATION));
  1706.             /* just ignore it! */
  1707.           }
  1708.           next=un->next;
  1709.           FREE(un);
  1710.           un=next;
  1711.         }
  1712.       }
  1713.       expr=expr->next;
  1714.     }
  1715.   }
  1716.   /*
  1717.    * Calculate all members of the linked list in the proper way and put
  1718.    * the result in "val->val.val" before returning "ret". Check for operators
  1719.    * with priority within `minpri' and `maxpri' which we got in the loop
  1720.    * above.
  1721.    *
  1722.    * Check priority level by priority level and perform the right actions.
  1723.    * When reaching the maxpri, there is only one number left: the result!
  1724.    */
  1725.  
  1726.   for(pri=minpri; pri<=maxpri; pri++) {
  1727.     last=expr=basexpr;
  1728.     while(expr=expr->next) {
  1729.       if(priority[expr->operator]==pri) {
  1730.         last->flags|=expr->flags;
  1731.         switch(expr->operator) {
  1732.         case OP_MULTIPLY:
  1733.           last->val.val*=expr->val.val;
  1734.           break;
  1735.         case OP_DIVISION:
  1736.           if(!expr->val.val) {
  1737.             CALL(Warn(scr, FPLERR_DIVISION_BY_ZERO));
  1738.             /* we give a zero as result! */
  1739.             last->val.val=0;
  1740.           } else
  1741.             last->val.val/=expr->val.val;
  1742.           break;
  1743.         case OP_REMAIN:
  1744.           if(!expr->val.val) {
  1745.             CALL(Warn(scr, FPLERR_DIVISION_BY_ZERO));
  1746.             last->val.val=0;
  1747.           } else
  1748.             last->val.val%=expr->val.val;
  1749.           break;
  1750.         case OP_SHIFTL:
  1751.           last->val.val<<=expr->val.val;
  1752.           break;
  1753.         case OP_SHIFTR:
  1754.           last->val.val>>=expr->val.val;
  1755.           break;
  1756.         case OP_BINAND:
  1757.           last->val.val&=expr->val.val;
  1758.           break;
  1759.         case OP_BINOR:
  1760.           last->val.val|=expr->val.val;
  1761.           break;
  1762.         case OP_BINXOR:
  1763.           last->val.val^=expr->val.val;
  1764.           break;
  1765.         case OP_PLUS:
  1766.           last->val.val+=expr->val.val;
  1767.           break;
  1768.         case OP_MINUS:
  1769.           last->val.val-=expr->val.val;
  1770.           break;
  1771.         case OP_EQUAL:
  1772.           last->val.val=last->val.val==expr->val.val;
  1773.           break;
  1774.         case OP_NOTEQ:
  1775.           last->val.val=last->val.val!=expr->val.val;
  1776.           break;
  1777.         case OP_LESSEQ:
  1778.           last->val.val=last->val.val<=expr->val.val;
  1779.           break;
  1780.         case OP_LESS:
  1781.           last->val.val=last->val.val<expr->val.val;
  1782.           break;
  1783.         case OP_GRETEQ:
  1784.           last->val.val=last->val.val>=expr->val.val;
  1785.           break;
  1786.         case OP_GRET:
  1787.           last->val.val=last->val.val>expr->val.val;
  1788.           break;
  1789.         case OP_LOGOR:
  1790.           last->val.val=last->val.val||expr->val.val;
  1791.           break;
  1792.         case OP_LOGAND:
  1793.           last->val.val=last->val.val&&expr->val.val;
  1794.           break;
  1795.         case OP_COND1:
  1796.           if(expr->next && expr->next->operator==OP_COND2) {
  1797.             last->val.val=last->val.val?expr->val.val:expr->next->val.val;
  1798.           } else {
  1799.             CALL(Warn(scr, FPLERR_ILLEGAL_CONDOP)); /* WARNING! */
  1800.             last->val.val=expr->val.val; /* get the number we have! */
  1801.           }
  1802.           break;
  1803.         }
  1804.         last->next=expr->next;
  1805.         FREE(expr);
  1806.         expr=last;
  1807.       } else
  1808.         last=expr;
  1809.     }
  1810.   }
  1811.   val->val.val=basexpr->val.val; /* get the final value */
  1812.   val->flags=basexpr->flags; /* copy the flags */
  1813.   return(FPL_OK);
  1814. }
  1815.  
  1816. /**********************************************************************
  1817.  *
  1818.  * AddUnary();
  1819.  *
  1820.  * Build a linked list on the unary member of the Expr struct!
  1821.  *
  1822.  ******/
  1823.  
  1824. static ReturnCode
  1825. AddUnary(struct Data *scr,
  1826.          struct Expr *expr,
  1827.          Operator unary)
  1828. {
  1829.   struct Unary *next=expr->unary;
  1830.  
  1831.   GETMEM(expr->unary, sizeof(struct Unary));
  1832.   expr->unary->unary=unary;
  1833.   expr->unary->next=next;
  1834.  
  1835.   return(FPL_OK);
  1836. }
  1837.  
  1838.  
  1839. /**********************************************************************
  1840.  *
  1841.  * Clean()
  1842.  *
  1843.  * Erases every track of the linked TalStruct list...
  1844.  *
  1845.  ******/
  1846.  
  1847. static void Clean(struct Data *scr, struct Expr *basexpr)
  1848. {
  1849.   struct Expr *last;
  1850.   while(basexpr) {
  1851.     last=basexpr->next;
  1852.     FREE(basexpr);
  1853.     basexpr=last;
  1854.   }
  1855. }
  1856.  
  1857. /**********************************************************************
  1858.  *
  1859.  * HandleString();
  1860.  *
  1861.  * Assigns the proper members in the Expr struct after a respons from
  1862.  * a user specified function.
  1863.  *
  1864.  *****/
  1865.  
  1866. static void INLINE HandleString(struct Data *scr,
  1867.                                 struct Expr *expr)
  1868. {
  1869.   struct fplMsg *msg;
  1870.   GetMessage(scr, FPLMSG_RETURN_STRING, &msg);
  1871.   if(!msg || !msg->message[0])
  1872.     /* We got a zero length string or no string at all! */
  1873.     expr->val.str=NULL; /* no string! */
  1874.   else
  1875.     expr->val.str=(struct fplStr *)msg->message[0]; /* the copied string! */
  1876.  
  1877.   expr->flags=FPL_STRING|FPL_ACTION;
  1878.   if(msg)
  1879.     DeleteMessage(scr, msg);
  1880. }
  1881.  
  1882. /**********************************************************************
  1883.  *
  1884.  * Convert()
  1885.  *
  1886.  * Converts the following "string" in the line to a string which it returns.
  1887.  *
  1888.  *********/
  1889.  
  1890. static ReturnCode INLINE Convert(struct Expr *expr, struct Data *scr)
  1891. {
  1892.   ReturnCode ret=FPL_OK;
  1893.   long a;
  1894.   unsigned long pos=0;  /* start position */
  1895.  
  1896.   struct fplStr *pointer, *pek;
  1897.  
  1898.   expr->flags|=FPL_STRING;
  1899.  
  1900. #ifdef STRING_STACK
  1901.   /*
  1902.      First, check with the static string stack to see if this string
  1903.      has already been parsed and is ready to simply restore.
  1904.      Put this string as most recently restored.
  1905.    */
  1906.  
  1907.   /*
  1908.      StringFromStack() uses the scr->text pointer to determine which string
  1909.      we want to have. It also moves our program pointer to the end of the
  1910.      string if it is there.
  1911.    */
  1912.   if(scr->strings_in_stack_max>0) {
  1913.     CALL(StringFromStack(scr, &pointer));
  1914.     if(pointer) {
  1915.       expr->val.str=pointer;
  1916.       expr->flags|=FPL_NOFREE|FPL_STACKED;
  1917.       return FPL_OK;
  1918.     }
  1919.   }
  1920. #endif
  1921.  
  1922.   GETMEM(pointer, sizeof(struct fplStr) + ADDSTRING_DEFAULT);
  1923.   /* create default string space */
  1924.  
  1925.   pointer->alloc=ADDSTRING_DEFAULT;
  1926.   pointer->len=0;
  1927.  
  1928.   expr->val.str=pointer;
  1929.  
  1930. #ifdef DEBUG
  1931.   CheckMem(scr, pointer);
  1932. #endif
  1933.   do {
  1934.     scr->text++;
  1935.     while(*scr->text!=CHAR_QUOTATION_MARK) {
  1936.       CALL(ReturnChar(scr, &a, TRUE));
  1937.       if(a<256) {
  1938.         pointer->string[pos]=a;
  1939.         if(++pos>=pointer->alloc) {
  1940.           GETMEM(pek, (pointer->alloc+=ADDSTRING_INC)+sizeof(struct fplStr));
  1941.           memcpy(pek, pointer, pos+sizeof(struct fplStr));
  1942.           FREE(pointer);
  1943.           pointer=pek;
  1944.           expr->val.str=pointer;
  1945.         }
  1946.       }
  1947.     }
  1948.     scr->text++;
  1949.     CALL(Eat(scr));
  1950.   } while(*scr->text==CHAR_QUOTATION_MARK);
  1951.   pointer->string[pos]=0; /* zero terminate */
  1952.   pointer->len=pos;       /* length of string */
  1953.   expr->val.str=pointer;
  1954. #ifdef STRING_STACK
  1955.   /*
  1956.      We push our newly scanned string on the string stack. Very useful if
  1957.      this string is reffered in i.e a loop.
  1958.    */
  1959.   if(scr->strings_in_stack_max>0) {
  1960.     CALL(StringToStack(scr, &pointer));
  1961.     if(pointer)
  1962.       /* no one may free a string in the stack! */
  1963.       expr->flags|=FPL_NOFREE|FPL_STACKED;
  1964.   }
  1965. #endif
  1966.  
  1967.   return(ret);
  1968. }
  1969.  
  1970. #ifdef STRING_STACK
  1971. static ReturnCode INLINE StringToStack(struct Data *scr,
  1972.                                        struct fplStr **string)
  1973. {
  1974.   if(scr->stringstackptr >= scr->strings_in_stack_max) {
  1975.     FREE(scr->stringkeeper[ 0 ]); /* free the previous holder of that position! */
  1976.     scr->stringstackptr = 0;
  1977.   } else
  1978.     scr->strings_in_stack_now++;
  1979.  
  1980.   scr->stringstack[ current_entry ].string = *string;
  1981.   scr->stringstack[ current_entry ].text = scr->text;
  1982.   scr->stringstack[ current_entry ].prg = scr->prg;
  1983.   scr->stringstack[ current_entry ].virprg = scr->virprg;
  1984.   scr->stringstackptr++;
  1985. }
  1986.  
  1987. static ReturnCode INLINE StringFromStack(struct Data *scr,
  1988.                                          struct fplStr **string)
  1989. {
  1990.   const long num = scr->stringstackptr;
  1991.   const long max = scr->strings_in_stack_max;
  1992.   long count;
  1993.   for(count=0; count<scr->strings_in_stack_now; count++) {
  1994.     if(scr->stringprogram[ (num-count) >= 0 ?
  1995.                            num-count :
  1996.                            max-count] == scr->text) {
  1997.       *string = scr->stringstack[ count ].string;
  1998.       scr->text = scr->stringstack[ count ].text;
  1999.       scr->prg = scr->stringstack[ count ].prg;
  2000.       scr->virprg = scr->stringstack[ count ].virprg;
  2001.       return FPL_OK;
  2002.     }
  2003.   }
  2004.   *string=NULL;
  2005.   return FPL_OK;
  2006. }
  2007.  
  2008. #endif
  2009.  
  2010. /**********************************************************************
  2011.  *
  2012.  * GetArrayInfo()
  2013.  *
  2014.  * Read the []'s and store the information. Make sure you're standing on
  2015.  * the open bracket!
  2016.  *
  2017.  * Set the int num points to, to any number if you want to limit the number
  2018.  * of dimension reads.
  2019.  */
  2020.  
  2021. static ReturnCode INLINE GetArrayInfo(struct Data *scr,
  2022.                                       long *dims,  /* long array */
  2023.                                       long *num,   /* number of dims */
  2024.                                       long control,
  2025.                                       char *name)  /* variable name */
  2026. {
  2027.   struct Expr *val;
  2028.   ReturnCode ret=FPL_OK;
  2029.   long maxnum=*num;
  2030.   GETMEM(val, sizeof(struct Expr));
  2031.   *num=0;
  2032.   if(*scr->text==CHAR_OPEN_BRACKET) {
  2033.     do {
  2034.       scr->text++; /* pass the open bracket */
  2035.       /* eval the expression: */
  2036.       CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  2037.  
  2038.       if(*scr->text!=CHAR_CLOSE_BRACKET) {
  2039.         /* no close bracket means error */
  2040.         CALL(Warn(scr, FPLERR_MISSING_BRACKET)); /* >warning< */
  2041.         /* go on anyway! */
  2042.       } else
  2043.         scr->text++;
  2044.  
  2045.       if(val->val.val<(control&CON_DECLARE?1:0)) {
  2046.         /* illegal result of the expression */
  2047.         /*
  2048.          * Write back the original variable name to the buffer!
  2049.          */
  2050.         strcpy(scr->buf, name);
  2051.         ret = FPLERR_ILLEGAL_ARRAY;
  2052.         break;
  2053.       }
  2054.  
  2055.       dims[(*num)++]=val->val.val; /* Add another dimension */
  2056.       if(*num==maxnum) {
  2057.         /* we've hit the roof! */
  2058.         break;
  2059.       } else if(*num==MAX_DIMS) {
  2060.         /* if we try to use too many dimensions... */
  2061.         ret=FPLERR_ILLEGAL_ARRAY;
  2062.         /*
  2063.          * Write back the original variable name to the buffer!
  2064.          */
  2065.         strcpy(scr->buf, name);
  2066.         break;
  2067.       }
  2068.       /*
  2069.        * Go on as long there are braces and we are declaring OR
  2070.        * as long the `num' variable tells us (you, know: when
  2071.        * you want to read character five in a member of a
  2072.        * three dimensional string array, it could look like
  2073.        * "int a=string[2][3][4][5];" ... :-)
  2074.        */
  2075.     } while(*scr->text==CHAR_OPEN_BRACKET);
  2076.   }
  2077.   FREE(val);
  2078.   return(ret);
  2079. }
  2080.  
  2081. /**********************************************************************
  2082.  *
  2083.  * ArrayNum()
  2084.  *
  2085.  * Return which array position we should look in when the user wants the
  2086.  * array member presented as a number of dimensions and an array with the
  2087.  * dimension sizes.
  2088.  *
  2089.  ******/
  2090.  
  2091. long REGARGS
  2092. ArrayNum(long num,     /* number of dimensions specified */
  2093.          long dnum,    /* number of dimensions declared  */
  2094.          long *dims,   /* dimensions specified */
  2095.          long *decl)   /* declared dimension information */
  2096. {
  2097.   long i;
  2098.   long pos=0;
  2099.   long base=1;
  2100.   if(num!=dnum)
  2101.     /*
  2102.      * Then we can't get proper information!!!
  2103.      */
  2104.     return(-1);
  2105.   for(i=0; i<num; i++) {
  2106.     if(dims[i]>=decl[i])
  2107.       return(-1);
  2108.  
  2109.     pos+=dims[i]*base;
  2110.     base*=decl[i];
  2111.   }
  2112.   return(pos);
  2113. }
  2114.  
  2115.  
  2116. /**********************************************************
  2117.  *
  2118.  * CallFunction()
  2119.  *
  2120.  * Calls a function. Internal, external or inside!!
  2121.  *
  2122.  *******/
  2123.  
  2124. static ReturnCode INLINE CallFunction(struct Data *scr,
  2125.                                       struct fplArgument *pass,
  2126.                                       struct Identifier *ident)
  2127. {
  2128.   ReturnCode ret;
  2129.   if(ident && ident->flags&FPL_INSIDE_FUNCTION) {
  2130.     CALL(inside(scr, pass, ident));
  2131.   } else if(ident && ident->flags&FPL_INTERNAL_FUNCTION) {
  2132.     CALL(functions(pass));
  2133.   } else { /* if (EXTERNAL_FUNCTION) */
  2134.     pass->funcdata=ident?ident->data.external.data:(void *)NULL;
  2135.  
  2136. #if defined(AMIGA) && defined(SHARED)
  2137.     if(ret=CheckStack(scr, scr->stack_limit, scr->stack_margin)) {
  2138.       if(ret==1)
  2139.         return(FPLERR_OUT_OF_MEMORY);
  2140.       else
  2141.         return(FPLERR_OUT_OF_STACK);
  2142.     }
  2143. #endif
  2144.  
  2145.     if(ident && ident->data.external.func) {
  2146.       /*
  2147.        * If this is non-zero, a function specific function pointer
  2148.        * has been assigned to it! In that case we should call that
  2149.        * function instead of the traditional, global one!
  2150.        */
  2151.       CALL(InterfaceCall(scr, pass, ident->data.external.func));
  2152.     } else {
  2153.       CALL(InterfaceCall(scr, pass, scr->function));
  2154.     }
  2155.  
  2156.   }
  2157.   return(FPL_OK);
  2158. }
  2159.  
  2160. /**********************************************************************
  2161.  *
  2162.  * inside();
  2163.  *
  2164.  * This function takes care of the inside function callings within a
  2165.  * FPL program (or in a FPL program where the function was declared using
  2166.  * `export').
  2167.  *
  2168.  ******/
  2169.  
  2170. static ReturnCode INLINE inside(struct Data *scr,
  2171.                                 struct fplArgument *arg,
  2172.                                 struct Identifier *func)
  2173. {
  2174.   /*
  2175.    * The function has been declared as an `inside' one.
  2176.    */
  2177.  
  2178.   ReturnCode ret=FPL_OK;
  2179.   struct Identifier *pident; /* pointer to identifier */
  2180.   struct Identifier *ident;
  2181.   char *t=scr->text;
  2182.   struct Local *locals=NULL;
  2183.   long p=scr->prg;
  2184.   char *file=scr->prog->name;
  2185.   long vp=scr->virprg;
  2186.   char *vf=scr->virfile;
  2187.   char count; /* parameter counter */
  2188.   char *text;
  2189.   struct Condition con;
  2190.   struct Expr *val;
  2191.   struct fplStr *string;
  2192.   char oldret;
  2193.   static unsigned long inttags[]={FPLSEND_INT, 0, FPLSEND_DONE};
  2194.   static unsigned long strtags[]={FPLSEND_STRING, 0, FPLSEND_STRLEN, 0,
  2195.                                     FPLSEND_DONE};
  2196.   char cont;
  2197.   long search;
  2198.   struct Program *prog=scr->prog;
  2199.   struct fplVariable *tempvar;
  2200.   char reference;
  2201.  
  2202.   GETMEM(val, sizeof(struct Expr));
  2203.   if(file!=func->data.inside.file) {
  2204.     struct Program *prog=scr->programs;
  2205.     while(prog) {
  2206.       if(prog->name && !strcmp(prog->name, func->data.inside.file))
  2207.         break;
  2208.       prog=prog->next;
  2209.     }
  2210.     if(prog) {
  2211.       CALL(LeaveProgram(scr, scr->prog));
  2212.       CALL(GetProgram(scr, prog));
  2213.       scr->prog=prog;
  2214.     } else
  2215.       return(FPLERR_INTERNAL_ERROR); /* This is a dead-end error! */
  2216.   }
  2217.  
  2218.   if(func->flags&FPL_INSIDE_NOTFOUND) {
  2219.     /*
  2220.      * We have no current information about where this function
  2221.      * is to be found. Search for it and store the location in
  2222.      * ->text and ->prg.
  2223.      */
  2224.  
  2225.     cont=TRUE;
  2226.     search=(func->data.inside.ret==FPL_STRARG)?CMD_STRING:
  2227.     (func->data.inside.ret==FPL_INTARG)?CMD_INT:CMD_VOID;
  2228.  
  2229.     /*
  2230.      * Start searching from the declaration position to enable local functions!
  2231.      */
  2232.  
  2233.     scr->text=(&scr->prog->program)[scr->prog->startprg-1]+
  2234.       func->data.inside.col;
  2235.     scr->prg=func->data.inside.prg;
  2236.     scr->virprg=func->data.inside.virprg;
  2237.     scr->virfile=func->data.inside.virfile;
  2238.     while(cont && !ret) {
  2239.       switch(*scr->text) {
  2240.       case CHAR_OPEN_BRACE:
  2241.         /* ...go to the corresponding brace */
  2242.         ret=GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE);
  2243.         break;
  2244.       case CHAR_OPEN_PAREN:
  2245.         /* ...go to the corresponding parenthesis */
  2246.         ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE);
  2247.         break;
  2248.       case CHAR_QUOTATION_MARK:
  2249.         scr->text++;
  2250.         /* dirty use of function: */
  2251.         ret=GetEnd(scr, CHAR_QUOTATION_MARK, CHAR_QUOTATION_MARK, FALSE);
  2252.         break;
  2253.       case CHAR_ASCII_ZERO:
  2254.         if(Newline(scr))
  2255.           ret=FPLERR_INSIDE_NOT_FOUND;
  2256.         break;
  2257.       case CHAR_DIVIDE: /* to eat comments */
  2258.       case CHAR_SPACE:
  2259.       case CHAR_TAB:
  2260.       case CHAR_NEWLINE:
  2261.         if(Eat(scr))
  2262.           ret=FPLERR_INSIDE_NOT_FOUND;
  2263.         if(*scr->text==CHAR_HASH) {
  2264.           /* This should read a #line statement for new virtual line number */
  2265.           while(*scr->text++!=CHAR_NEWLINE);
  2266.           scr->virprg++;
  2267.         }
  2268.         break;
  2269.       case CHAR_CLOSE_BRACE: /* local function searches might hit this! */
  2270.         ret=FPLERR_INSIDE_NOT_FOUND;
  2271.         break;
  2272.       default:
  2273.         if(isident(*scr->text)) {
  2274.           Getword(scr);
  2275.           GetIdentifier(scr, scr->buf, &pident);
  2276.           if(pident && /* valid identifier */
  2277.              pident->data.external.ID==search) {  /* and it's the right one */
  2278.             if(!Getword(scr)) {
  2279.               GetIdentifier(scr, scr->buf, &pident);
  2280.               if(pident && pident->flags&FPL_INSIDE_FUNCTION) /* an inside */
  2281.                 cont=strcmp(pident->name, func->name); /* is it the right? */
  2282.             }
  2283.           } else
  2284.             while(isident(*scr->text))
  2285.               scr->text++;
  2286.         } else
  2287.           scr->text++;
  2288.         break;
  2289.       }
  2290.     }
  2291.     if(ret) {
  2292.       strcpy(scr->buf, func->name); /* enable better error report! */
  2293.       scr->prg=p;
  2294.       scr->text=t;
  2295.       scr->virprg=vp;
  2296.       return FPLERR_INSIDE_NOT_FOUND; /* dead end error */
  2297.     }
  2298.     func->data.inside.col=scr->text-(&scr->prog->program)[scr->prg-1];
  2299.     func->data.inside.prg=scr->prg;
  2300.     func->data.inside.virprg=scr->virprg;
  2301.     func->data.inside.virfile=scr->virfile;
  2302.     func->flags&=~FPL_INSIDE_NOTFOUND; /* we have found it! */
  2303.   } else {
  2304.     /*
  2305.      * We know where to find this function!
  2306.      */
  2307.  
  2308.     scr->prg=func->data.inside.prg;
  2309.     scr->text=(&scr->prog->program)[scr->prg-1]+func->data.inside.col;
  2310.     scr->virprg=func->data.inside.virprg;
  2311.     scr->virfile=func->data.inside.virfile;
  2312.   }
  2313.  
  2314.   /**********************************
  2315.    * PARSE THE PARAMETER LIST HERE! *
  2316.    **********************************/
  2317.  
  2318.   CALL(Eat(scr));
  2319.  
  2320.   if(*scr->text!=CHAR_OPEN_PAREN) {
  2321.     CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  2322.     /* we can survive without that! */
  2323.   } else
  2324.     scr->text++;
  2325.  
  2326.   if(func->data.inside.format) {
  2327.     /*
  2328.      * We won't hit this if no arguments is prototyped.
  2329.      */
  2330.  
  2331.     count=0; /* parameter counter */
  2332.     text=func->data.inside.format;
  2333.  
  2334.     if(!*text) {
  2335.       if(!Getword(scr) && strcmp(scr->buf, "void")) {
  2336.         /* it should be "void" or nothing! If it wasn't we fail! */
  2337.         CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));
  2338.       }
  2339.     } else {
  2340.       while(*text && !ret) {
  2341.         CALL(Getword(scr));
  2342.         CALL(GetIdentifier(scr, scr->buf, &ident));
  2343.     CALL(Eat(scr));
  2344.         if(scr->text[0]==CHAR_MULTIPLY) {
  2345.       reference=TRUE;
  2346.       scr->text++; /* pass it! */
  2347.     }
  2348.     else
  2349.           reference=FALSE; /* no reference! */
  2350.  
  2351.         switch(*text) {
  2352.         case FPL_STRARG:
  2353.         case FPL_INTARG:
  2354.       if(reference) {
  2355.         /*
  2356.          * It was said to a symbol reference!!
  2357.          */
  2358.             CALL(Warn(scr, FPLERR_ILLEGAL_REFERENCE));
  2359.       }
  2360.           if(*text==FPL_STRARG &&
  2361.              ident->data.external.ID!=CMD_STRING) {
  2362.             CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));
  2363.             /* we create the variable that was declared in the prototype! */
  2364.           } else if(*text==FPL_INTARG &&
  2365.                     ident->data.external.ID!=CMD_INT) {
  2366.             CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));
  2367.             /* we create the variable that was declared in the prototype! */
  2368.           }
  2369.           /*
  2370.            * Declare the following word as a string or integer
  2371.            * variable.
  2372.            */
  2373.           GETMEM(pident, sizeof(struct Identifier));
  2374.  
  2375.           CALL(Getword(scr));
  2376.  
  2377.           tempvar=&pident->data.variable;
  2378.  
  2379.           pident->flags=(*text==FPL_INTARG?FPL_INT_VARIABLE:
  2380.                          FPL_STRING_VARIABLE)|
  2381.                            (ident->flags&FPL_VARIABLE_LESS32);
  2382.  
  2383.           STRDUP(pident->name, scr->buf);
  2384.  
  2385.           tempvar->num=0; /* This is not an array */
  2386.           tempvar->size=1; /* This is not an array */
  2387.           GETMEM(tempvar->var.val32, sizeof(void *));
  2388.           if(*text==FPL_INTARG) {
  2389.             tempvar->var.val32[0]=(long)arg->argv[count];
  2390.           } else {
  2391.             /* Store string length in variable `len' */
  2392.             register long len=GETSTRLEN(arg->argv[count]);
  2393.             GETMEM(tempvar->var.str[0], sizeof(struct fplStr)+len);
  2394.             tempvar->var.str[0]->alloc=len;
  2395.  
  2396.             /* We copy the ending zero termination too! */
  2397.             memcpy(tempvar->var.str[0]->string, ((char *)arg->argv[count]), len+1);
  2398.             tempvar->var.str[0]->len=len;
  2399.           }
  2400.           /*
  2401.            * Emulate next level variable declaration by adding one
  2402.            * to the ->level member here... dirty but (fully?)
  2403.            * functional!!!! ;-)
  2404.            */
  2405.  
  2406.           pident->level=scr->varlevel+1;
  2407.           pident->file=scr->prog->name;
  2408.           pident->func=func;
  2409.           CALL(AddVar(scr, pident, &locals));
  2410.           break;
  2411.         case FPL_STRVARARG:
  2412.         case FPL_INTVARARG:
  2413.     case FPL_STRARRAYVARARG:
  2414.     case FPL_INTARRAYVARARG:
  2415.       if(!reference) {
  2416.         /*
  2417.          * It was never said to be a symbol reference!!
  2418.          */
  2419.             CALL(Warn(scr, FPLERR_ILLEGAL_REFERENCE));
  2420.       }
  2421.           if((*text==FPL_STRVARARG || *text == FPL_STRARRAYVARARG) &&
  2422.          ident->data.external.ID!=CMD_STRING) {
  2423.           CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));
  2424.             /* create a string reference anyway! */
  2425.           } else if((*text==FPL_INTVARARG || *text == FPL_INTARRAYVARARG) &&
  2426.             ident->data.external.ID!=CMD_INT) {
  2427.             CALL(Warn(scr, FPLERR_ILLEGAL_DECLARE));
  2428.             /* create an int reference anyway! */
  2429.           }
  2430.           /*
  2431.            * Declare the following word as a variable which
  2432.            * will use the struct fplVariable pointer as given in the
  2433.            * calling parameter list.
  2434.            */
  2435.  
  2436.           CALL(Getword(scr));
  2437.  
  2438.       if(*text == FPL_INTARRAYVARARG ||
  2439.          *text == FPL_STRARRAYVARARG) {
  2440.           CALL(Eat(scr));
  2441.               if(CHAR_OPEN_BRACKET != scr->text[0])
  2442.                   return FPLERR_ILLEGAL_DECLARE;
  2443.           if(GetEnd(scr, CHAR_CLOSE_BRACKET, CHAR_OPEN_BRACKET, FALSE))
  2444.                 return FPLERR_MISSING_BRACKET;
  2445.       }
  2446.  
  2447.           if(arg->argv[count]) {
  2448.             /*
  2449.              * If the wrong kind of variable was sent in the function call, no
  2450.              * varible will be sent, and no one will be declared.
  2451.              */
  2452.  
  2453.             GETMEM(pident, sizeof(struct Identifier));
  2454.  
  2455.             *pident=*(struct Identifier *)arg->argv[count];
  2456.             pident->flags |= FPL_REFERENCE;
  2457.             pident->data.variable.ref= (struct Identifier *)arg->argv[count];
  2458.             /* original fplVariable position */
  2459.  
  2460.             STRDUP(pident->name, scr->buf);
  2461.  
  2462.             pident->level=scr->varlevel+1;
  2463.             pident->file=scr->prog->name;
  2464.             pident->func=func;
  2465.             CALL(AddVar(scr, pident, &locals));
  2466.           }
  2467.           break;
  2468.         }
  2469.         CALL(Eat(scr));
  2470.  
  2471.         if(*++text && *scr->text++!=CHAR_COMMA)
  2472.           /*
  2473.            * There is no way out from this error exception. Leaving a parameter
  2474.            * really is a sever thing!
  2475.            */
  2476.           return(FPLERR_MISSING_ARGUMENT);
  2477.         count++;
  2478.       }
  2479.     }
  2480.  
  2481.     CALL(Eat(scr));
  2482.  
  2483.     if(*scr->text!=CHAR_CLOSE_PAREN) {
  2484.       CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  2485.       /* who needs ending parentheses? */
  2486.     } else
  2487.       scr->text++;
  2488.   } else {
  2489.     /*
  2490.      * No argument is useable to this function. There might be a
  2491.      * `void' keyword here, but nothing else! Just search for the
  2492.      * closing parenthesis to fasten interpreting!
  2493.      */
  2494.  
  2495.     if(ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, FALSE)) {
  2496.       CALL(Warn(scr, FPLERR_MISSING_PARENTHESES));
  2497.       /* ok, then search for the open brace where the program starts! */
  2498.       ret=GetEnd(scr, CHAR_OPEN_BRACE, CHAR_OPEN_PAREN, FALSE);
  2499.       if(ret) {
  2500.         CALL(Warn(scr, FPLERR_MISSING_BRACE));
  2501.       } else
  2502.         scr->text--; /* back on brace */
  2503.       /* ok, then we say that the program starts right here! */
  2504.     }
  2505.   }
  2506.  
  2507.   /*********************
  2508.    * RUN THE FUNCTION! *
  2509.    *********************/
  2510.  
  2511.   oldret=scr->strret;
  2512.   scr->strret=func->data.inside.ret==FPL_STRARG; /* should we receive a string? */
  2513.   CALL(Eat(scr));
  2514.   if(*scr->text!=CHAR_OPEN_BRACE) {
  2515.     CALL(Warn(scr, FPLERR_MISSING_BRACE));
  2516.     /* we can do with a start without it! */
  2517.   } else
  2518.     scr->text++;
  2519.  
  2520.   con.bracetext=scr->text;
  2521.   con.braceprg=scr->prg;
  2522.   text=(void *)scr->func; /* backup current */
  2523.   scr->func=func;
  2524.  
  2525.   scr->prog->openings++;
  2526.   ret=Script(scr, val, SCR_BRACE|SCR_FUNCTION, &con);
  2527.   scr->prog->openings--;
  2528.  
  2529.   /*
  2530.    * Delete all variables created on our list for use
  2531.    * only in the function we just came back from!
  2532.    */
  2533.   DelLocalVar(scr, &locals);
  2534.  
  2535.   if(ret) {
  2536.     if(scr->prog != prog) {
  2537.       LeaveProgram(scr, scr->prog); /* leave the failed program! */
  2538.       GetProgram(scr, prog); /* fetch the previous program again! */
  2539.     }
  2540.     return(ret);
  2541.   }
  2542.   scr->func=(void *)text; /* restore last */
  2543.  
  2544.   if(scr->strret) {
  2545.     /* we should return a string */
  2546.     string=val->val.str;
  2547.  
  2548.     strtags[1]=(long)string->string;
  2549.     strtags[3]=string->len;
  2550.     CALL(Send(scr, strtags));
  2551.     FREE(string);
  2552.   } else {
  2553.     inttags[1]=val->val.val;
  2554.     CALL(Send(scr, inttags));
  2555.   }
  2556.  
  2557.   FREE(val);
  2558.  
  2559.   scr->text=t;
  2560.   scr->prg=p;
  2561.   scr->virprg=vp;
  2562.   scr->virfile=vf;
  2563.   scr->strret=oldret;
  2564.   if(scr->prog!=prog) {
  2565.     CALL(LeaveProgram(scr, scr->prog));
  2566.     scr->prog=prog;
  2567.     CALL(GetProgram(scr, scr->prog));
  2568.   }
  2569.   return(FPL_OK);
  2570. }
  2571.  
  2572. static ReturnCode INLINE PrototypeInside(struct Data *scr,
  2573.                      struct Expr *val,
  2574.                      long control,
  2575.                      struct Identifier *ident)
  2576. {
  2577.   /*
  2578.    * Prototyping an `inside' function!
  2579.    *
  2580.    * We have already received the return type, now we must
  2581.    * parse the paraters given within the parentheses. Legal
  2582.    * parameters are only combinations of `string', `int',
  2583.    * `string &' and `int &', or a single `void' (if no argument
  2584.    * should be sent to the function). Arguments specified in
  2585.    * a prototype is required, there is no way to specify an
  2586.    * optional parameter or a parameter list.
  2587.    */
  2588.  
  2589.   struct Identifier *pident;
  2590.   long pos=0;
  2591.   ReturnCode ret = FPL_OK;
  2592.   char *array;
  2593.   char found=ident?TRUE:FALSE;
  2594.  
  2595.   if(!found) {
  2596.     GETMEM(pident, sizeof(struct Identifier));
  2597.     STRDUP(pident->name, scr->buf);
  2598.   } else {
  2599.     /* we already know about this function! */
  2600.     if(ident->flags&(FPL_INTERNAL_FUNCTION|FPL_KEYWORD|FPL_EXTERNAL_FUNCTION))
  2601.       return FPLERR_IDENTIFIER_USED;
  2602.     pident = ident;
  2603.   }
  2604.  
  2605.   if(!found || (found && ident->flags&FPL_INSIDE_NOTFOUND)) {
  2606.     /* we know where this is... */
  2607.     pident->data.inside.col=scr->text-(&scr->prog->program)[scr->prg-1];
  2608.     pident->data.inside.prg=scr->prg;
  2609.     pident->data.inside.file=scr->prog->name;
  2610.     pident->data.inside.virprg=scr->virprg;
  2611.     pident->data.inside.virfile=scr->virfile;
  2612.  
  2613.     pident->file=scr->prog->name; /* file! */
  2614.     pident->func=scr->func; /* declared in this function */
  2615.     pident->level=control&CON_DECLGLOB?0:scr->varlevel;
  2616.   }
  2617.  
  2618.   if(found) {
  2619.     /* we already know about this function! */
  2620.  
  2621.     CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2622.  
  2623.     CALL(Eat(scr));
  2624.  
  2625.     if(scr->text[0]==CHAR_OPEN_BRACE) {
  2626.       /* now the function is found! */
  2627.       if(!(ident->flags&FPL_INSIDE_NOTFOUND))
  2628.         /* the function has already been defined and is defined here again! */
  2629.         return FPLERR_IDENTIFIER_USED;
  2630.  
  2631.       ident->flags&=~FPL_INSIDE_NOTFOUND;
  2632.  
  2633.       if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE))
  2634.         return FPLERR_MISSING_BRACE;
  2635.       scr->text--; /* back on close brace */
  2636.       val->flags|=FPL_DEFUNCTION;
  2637.     }
  2638.  
  2639.     return FPL_OK;
  2640.   }
  2641.  
  2642.   pident->flags=FPL_INSIDE_FUNCTION|
  2643.     (control&CON_DECLEXP?FPL_EXPORT_SYMBOL:0)|
  2644.       (control&CON_DECLGLOB?FPL_GLOBAL_SYMBOL:0);
  2645.  
  2646.   scr->text++; /* pass the open parenthesis */
  2647.  
  2648.   CALL(Eat(scr));
  2649.  
  2650.   GETMEM(array, MAX_ARGUMENTS * sizeof(char));
  2651.  
  2652.   while(pos<MAX_ARGUMENTS) {
  2653.     if(*scr->text==CHAR_CLOSE_PAREN) {
  2654.       scr->text++;
  2655.       break;
  2656.     }
  2657.     CALL(Getword(scr));
  2658.     CALL(GetIdentifier(scr, scr->buf, &ident));
  2659.     CALL(Eat(scr));
  2660.     switch(ident->data.external.ID) {
  2661.     case CMD_VOID:
  2662.       if(*scr->text!=CHAR_CLOSE_PAREN) {
  2663.         CALL(Warn(scr, FPLERR_ILLEGAL_PROTOTYPE));
  2664.         CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2665.       } else
  2666.         scr->text++;
  2667.       break;
  2668.  
  2669.     case CMD_STRING:
  2670.     case CMD_INT:
  2671.       if(*scr->text==CHAR_MULTIPLY) {
  2672.         scr->text++;
  2673.         Getword(scr); /* eat word if there's any! */
  2674.         if(CHAR_OPEN_BRACKET == scr->text[0]) {
  2675.           if(GetEnd(scr, CHAR_CLOSE_BRACKET, CHAR_OPEN_BRACKET, FALSE))
  2676.             return FPLERR_MISSING_BRACKET;
  2677.           array[pos]=(ident->data.external.ID==CMD_STRING)?FPL_STRARRAYVARARG:
  2678.           FPL_INTARRAYVARARG;
  2679.         }
  2680.         else
  2681.           array[pos]=(ident->data.external.ID==CMD_STRING)?FPL_STRVARARG:
  2682.           FPL_INTVARARG;
  2683.       } else
  2684.         array[pos]=(ident->data.external.ID==CMD_STRING)?FPL_STRARG:
  2685.         FPL_INTARG;
  2686.       break;
  2687.  
  2688.     default:
  2689.       CALL(Warn(scr, FPLERR_ILLEGAL_PROTOTYPE));
  2690.       continue; /* if we against all odds are ordered to go on! */
  2691.     }
  2692.     if(CMD_VOID == ident->data.external.ID)
  2693.       break;
  2694.  
  2695.     pos++;
  2696.     if(isident(*scr->text)) {
  2697.       Getword(scr);
  2698.       CALL(Eat(scr));
  2699.     }
  2700.  
  2701.     if(*scr->text==CHAR_COMMA)
  2702.       scr->text++;
  2703.     else if(*scr->text!=CHAR_CLOSE_PAREN) {
  2704.       CALL(Warn(scr, FPLERR_ILLEGAL_PROTOTYPE));
  2705.       /* we can go on if we just forgot the closing parenthesis */
  2706.     }
  2707.   }
  2708.  
  2709.   array[pos]=0; /* terminate string */
  2710.  
  2711.   /*
  2712.    * We have all information now. AddIdentifier().
  2713.    */
  2714.  
  2715.   pident->data.inside.ret=(control&CON_DECLSTR)?FPL_STRARG:
  2716.     (control&CON_DECLINT)?FPL_INTARG:FPL_VOIDARG;
  2717.   GETMEM(pident->data.inside.format, pos+1);
  2718.   strcpy(pident->data.inside.format, array);
  2719.   FREE(array);
  2720.  
  2721.   CALL(Eat(scr)); /* Eat white space */
  2722.  
  2723.  
  2724.   if(*scr->text==CHAR_OPEN_BRACE) {
  2725.     /* It's the actual function!!! */
  2726.     if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE))
  2727.       return FPLERR_MISSING_BRACE;
  2728.     scr->text--; /* back on close brace */
  2729.     val->flags|=FPL_DEFUNCTION;
  2730.   } else {
  2731.     val->flags&=~FPL_DEFUNCTION;
  2732.     pident->flags|=FPL_INSIDE_NOTFOUND;
  2733.   }
  2734.   CALL(AddVar(scr, pident,
  2735.               control&CON_DECLGLOB?&scr->globals:&scr->locals));
  2736.  
  2737.   return(ret);
  2738. }
  2739.